home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / pp.c < prev    next >
C/C++ Source or Header  |  1998-07-22  |  89KB  |  4,516 lines
  1. /*    pp.c
  2.  *
  3.  *    Copyright (c) 1991-1997, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "It's a big house this, and very peculiar.  Always a bit more to discover,
  12.  * and no knowing what you'll find around a corner.  And Elves, sir!" --Samwise
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. /*
  19.  * The compiler on Concurrent CX/UX systems has a subtle bug which only
  20.  * seems to show up when compiling pp.c - it generates the wrong double
  21.  * precision constant value for (double)UV_MAX when used inline in the body
  22.  * of the code below, so this makes a static variable up front (which the
  23.  * compiler seems to get correct) and uses it in place of UV_MAX below.
  24.  */
  25. #ifdef CXUX_BROKEN_CONSTANT_CONVERT
  26. static double UV_MAX_cxux = ((double)UV_MAX);
  27. #endif
  28.  
  29. /*
  30.  * Types used in bitwise operations.
  31.  *
  32.  * Normally we'd just use IV and UV.  However, some hardware and
  33.  * software combinations (e.g. Alpha and current OSF/1) don't have a
  34.  * floating-point type to use for NV that has adequate bits to fully
  35.  * hold an IV/UV.  (In other words, sizeof(long) == sizeof(double).)
  36.  *
  37.  * It just so happens that "int" is the right size almost everywhere.
  38.  */
  39. typedef int IBW;
  40. typedef unsigned UBW;
  41.  
  42. /*
  43.  * Mask used after bitwise operations.
  44.  *
  45.  * There is at least one realm (Cray word machines) that doesn't
  46.  * have an integral type (except char) small enough to be represented
  47.  * in a double without loss; that is, it has no 32-bit type.
  48.  */
  49. #if LONGSIZE > 4  && defined(_CRAY) && !defined(_CRAYMPP)
  50. #  define BW_BITS  32
  51. #  define BW_MASK  ((1 << BW_BITS) - 1)
  52. #  define BW_SIGN  (1 << (BW_BITS - 1))
  53. #  define BWi(i)  (((i) & BW_SIGN) ? ((i) | ~BW_MASK) : ((i) & BW_MASK))
  54. #  define BWu(u)  ((u) & BW_MASK)
  55. #else
  56. #  define BWi(i)  (i)
  57. #  define BWu(u)  (u)
  58. #endif
  59.  
  60. /*
  61.  * Offset for integer pack/unpack.
  62.  *
  63.  * On architectures where I16 and I32 aren't really 16 and 32 bits,
  64.  * which for now are all Crays, pack and unpack have to play games.
  65.  */
  66.  
  67. /*
  68.  * These values are required for portability of pack() output.
  69.  * If they're not right on your machine, then pack() and unpack()
  70.  * wouldn't work right anyway; you'll need to apply the Cray hack.
  71.  * (I'd like to check them with #if, but you can't use sizeof() in
  72.  * the preprocessor.)  --???
  73.  */
  74. /*
  75.     The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE
  76.     defines are now in config.h.  --Andy Dougherty  April 1998
  77.  */
  78. #define SIZE16 2
  79. #define SIZE32 4
  80.  
  81. #if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
  82. #  if BYTEORDER == 0x12345678
  83. #    define OFF16(p)    (char*)(p)
  84. #    define OFF32(p)    (char*)(p)
  85. #  else
  86. #    if BYTEORDER == 0x87654321
  87. #      define OFF16(p)    ((char*)(p) + (sizeof(U16) - SIZE16))
  88. #      define OFF32(p)    ((char*)(p) + (sizeof(U32) - SIZE32))
  89. #    else
  90.        }}}} bad cray byte order
  91. #    endif
  92. #  endif
  93. #  define COPY16(s,p)  (*(p) = 0, Copy(s, OFF16(p), SIZE16, char))
  94. #  define COPY32(s,p)  (*(p) = 0, Copy(s, OFF32(p), SIZE32, char))
  95. #  define CAT16(sv,p)  sv_catpvn(sv, OFF16(p), SIZE16)
  96. #  define CAT32(sv,p)  sv_catpvn(sv, OFF32(p), SIZE32)
  97. #else
  98. #  define COPY16(s,p)  Copy(s, p, SIZE16, char)
  99. #  define COPY32(s,p)  Copy(s, p, SIZE32, char)
  100. #  define CAT16(sv,p)  sv_catpvn(sv, (char*)(p), SIZE16)
  101. #  define CAT32(sv,p)  sv_catpvn(sv, (char*)(p), SIZE32)
  102. #endif
  103.  
  104. #ifndef PERL_OBJECT
  105. static void doencodes _((SV* sv, char* s, I32 len));
  106. static SV* refto _((SV* sv));
  107. static U32 seed _((void));
  108. #endif
  109.  
  110. static bool srand_called = FALSE;
  111.  
  112. /* variations on pp_null */
  113.  
  114. #ifdef I_UNISTD
  115. #include <unistd.h>
  116. #endif
  117.  
  118. /* XXX I can't imagine anyone who doesn't have this actually _needs_
  119.    it, since pid_t is an integral type.
  120.    --AD  2/20/1998
  121. */
  122. #ifdef NEED_GETPID_PROTO
  123. extern Pid_t getpid (void);
  124. #endif
  125.  
  126. PP(pp_stub)
  127. {
  128.     djSP;
  129.     if (GIMME_V == G_SCALAR)
  130.     XPUSHs(&PL_sv_undef);
  131.     RETURN;
  132. }
  133.  
  134. PP(pp_scalar)
  135. {
  136.     return NORMAL;
  137. }
  138.  
  139. /* Pushy stuff. */
  140.  
  141. PP(pp_padav)
  142. {
  143.     djSP; dTARGET;
  144.     if (PL_op->op_private & OPpLVAL_INTRO)
  145.     SAVECLEARSV(PL_curpad[PL_op->op_targ]);
  146.     EXTEND(SP, 1);
  147.     if (PL_op->op_flags & OPf_REF) {
  148.     PUSHs(TARG);
  149.     RETURN;
  150.     }
  151.     if (GIMME == G_ARRAY) {
  152.     I32 maxarg = AvFILL((AV*)TARG) + 1;
  153.     EXTEND(SP, maxarg);
  154.     if (SvMAGICAL(TARG)) {
  155.         U32 i;
  156.         for (i=0; i < maxarg; i++) {
  157.         SV **svp = av_fetch((AV*)TARG, i, FALSE);
  158.         SP[i+1] = (svp) ? *svp : &PL_sv_undef;
  159.         }
  160.     }
  161.     else {
  162.         Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
  163.     }
  164.     SP += maxarg;
  165.     }
  166.     else {
  167.     SV* sv = sv_newmortal();
  168.     I32 maxarg = AvFILL((AV*)TARG) + 1;
  169.     sv_setiv(sv, maxarg);
  170.     PUSHs(sv);
  171.     }
  172.     RETURN;
  173. }
  174.  
  175. PP(pp_padhv)
  176. {
  177.     djSP; dTARGET;
  178.     I32 gimme;
  179.  
  180.     XPUSHs(TARG);
  181.     if (PL_op->op_private & OPpLVAL_INTRO)
  182.     SAVECLEARSV(PL_curpad[PL_op->op_targ]);
  183.     if (PL_op->op_flags & OPf_REF)
  184.     RETURN;
  185.     gimme = GIMME_V;
  186.     if (gimme == G_ARRAY) {
  187.     RETURNOP(do_kv(ARGS));
  188.     }
  189.     else if (gimme == G_SCALAR) {
  190.     SV* sv = sv_newmortal();
  191.     if (HvFILL((HV*)TARG))
  192.         sv_setpvf(sv, "%ld/%ld",
  193.               (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1);
  194.     else
  195.         sv_setiv(sv, 0);
  196.     SETs(sv);
  197.     }
  198.     RETURN;
  199. }
  200.  
  201. PP(pp_padany)
  202. {
  203.     DIE("NOT IMPL LINE %d",__LINE__);
  204. }
  205.  
  206. /* Translations. */
  207.  
  208. PP(pp_rv2gv)
  209. {
  210.     djSP; dTOPss;
  211.  
  212.     if (SvROK(sv)) {
  213.       wasref:
  214.     sv = SvRV(sv);
  215.     if (SvTYPE(sv) == SVt_PVIO) {
  216.         GV *gv = (GV*) sv_newmortal();
  217.         gv_init(gv, 0, "", 0, 0);
  218.         GvIOp(gv) = (IO *)sv;
  219.         (void)SvREFCNT_inc(sv);
  220.         sv = (SV*) gv;
  221.     } else if (SvTYPE(sv) != SVt_PVGV)
  222.         DIE("Not a GLOB reference");
  223.     }
  224.     else {
  225.     if (SvTYPE(sv) != SVt_PVGV) {
  226.         char *sym;
  227.  
  228.         if (SvGMAGICAL(sv)) {
  229.         mg_get(sv);
  230.         if (SvROK(sv))
  231.             goto wasref;
  232.         }
  233.         if (!SvOK(sv)) {
  234.         if (PL_op->op_flags & OPf_REF ||
  235.             PL_op->op_private & HINT_STRICT_REFS)
  236.             DIE(no_usym, "a symbol");
  237.         if (PL_dowarn)
  238.             warn(warn_uninit);
  239.         RETSETUNDEF;
  240.         }
  241.         sym = SvPV(sv, PL_na);
  242.         if (PL_op->op_private & HINT_STRICT_REFS)
  243.         DIE(no_symref, sym, "a symbol");
  244.         sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
  245.     }
  246.     }
  247.     if (PL_op->op_private & OPpLVAL_INTRO)
  248.     save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL));
  249.     SETs(sv);
  250.     RETURN;
  251. }
  252.  
  253. PP(pp_rv2sv)
  254. {
  255.     djSP; dTOPss;
  256.  
  257.     if (SvROK(sv)) {
  258.       wasref:
  259.     sv = SvRV(sv);
  260.     switch (SvTYPE(sv)) {
  261.     case SVt_PVAV:
  262.     case SVt_PVHV:
  263.     case SVt_PVCV:
  264.         DIE("Not a SCALAR reference");
  265.     }
  266.     }
  267.     else {
  268.     GV *gv = (GV*)sv;
  269.     char *sym;
  270.  
  271.     if (SvTYPE(gv) != SVt_PVGV) {
  272.         if (SvGMAGICAL(sv)) {
  273.         mg_get(sv);
  274.         if (SvROK(sv))
  275.             goto wasref;
  276.         }
  277.         if (!SvOK(sv)) {
  278.         if (PL_op->op_flags & OPf_REF ||
  279.             PL_op->op_private & HINT_STRICT_REFS)
  280.             DIE(no_usym, "a SCALAR");
  281.         if (PL_dowarn)
  282.             warn(warn_uninit);
  283.         RETSETUNDEF;
  284.         }
  285.         sym = SvPV(sv, PL_na);
  286.         if (PL_op->op_private & HINT_STRICT_REFS)
  287.         DIE(no_symref, sym, "a SCALAR");
  288.         gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
  289.     }
  290.     sv = GvSV(gv);
  291.     }
  292.     if (PL_op->op_flags & OPf_MOD) {
  293.     if (PL_op->op_private & OPpLVAL_INTRO)
  294.         sv = save_scalar((GV*)TOPs);
  295.     else if (PL_op->op_private & OPpDEREF)
  296.         vivify_ref(sv, PL_op->op_private & OPpDEREF);
  297.     }
  298.     SETs(sv);
  299.     RETURN;
  300. }
  301.  
  302. PP(pp_av2arylen)
  303. {
  304.     djSP;
  305.     AV *av = (AV*)TOPs;
  306.     SV *sv = AvARYLEN(av);
  307.     if (!sv) {
  308.     AvARYLEN(av) = sv = NEWSV(0,0);
  309.     sv_upgrade(sv, SVt_IV);
  310.     sv_magic(sv, (SV*)av, '#', Nullch, 0);
  311.     }
  312.     SETs(sv);
  313.     RETURN;
  314. }
  315.  
  316. PP(pp_pos)
  317. {
  318.     djSP; dTARGET; dPOPss;
  319.  
  320.     if (PL_op->op_flags & OPf_MOD) {
  321.     if (SvTYPE(TARG) < SVt_PVLV) {
  322.         sv_upgrade(TARG, SVt_PVLV);
  323.         sv_magic(TARG, Nullsv, '.', Nullch, 0);
  324.     }
  325.  
  326.     LvTYPE(TARG) = '.';
  327.     if (LvTARG(TARG) != sv) {
  328.         if (LvTARG(TARG))
  329.         SvREFCNT_dec(LvTARG(TARG));
  330.         LvTARG(TARG) = SvREFCNT_inc(sv);
  331.     }
  332.     PUSHs(TARG);    /* no SvSETMAGIC */
  333.     RETURN;
  334.     }
  335.     else {
  336.     MAGIC* mg;
  337.  
  338.     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
  339.         mg = mg_find(sv, 'g');
  340.         if (mg && mg->mg_len >= 0) {
  341.         PUSHi(mg->mg_len + PL_curcop->cop_arybase);
  342.         RETURN;
  343.         }
  344.     }
  345.     RETPUSHUNDEF;
  346.     }
  347. }
  348.  
  349. PP(pp_rv2cv)
  350. {
  351.     djSP;
  352.     GV *gv;
  353.     HV *stash;
  354.  
  355.     /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
  356.     /* (But not in defined().) */
  357.     CV *cv = sv_2cv(TOPs, &stash, &gv, !(PL_op->op_flags & OPf_SPECIAL));
  358.     if (cv) {
  359.     if (CvCLONE(cv))
  360.         cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
  361.     }
  362.     else
  363.     cv = (CV*)&PL_sv_undef;
  364.     SETs((SV*)cv);
  365.     RETURN;
  366. }
  367.  
  368. PP(pp_prototype)
  369. {
  370.     djSP;
  371.     CV *cv;
  372.     HV *stash;
  373.     GV *gv;
  374.     SV *ret;
  375.  
  376.     ret = &PL_sv_undef;
  377.     if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
  378.     char *s = SvPVX(TOPs);
  379.     if (strnEQ(s, "CORE::", 6)) {
  380.         int code;
  381.         
  382.         code = keyword(s + 6, SvCUR(TOPs) - 6);
  383.         if (code < 0) {    /* Overridable. */
  384. #define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
  385.         int i = 0, n = 0, seen_question = 0;
  386.         I32 oa;
  387.         char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
  388.  
  389.         while (i < MAXO) {    /* The slow way. */
  390.             if (strEQ(s + 6, op_name[i]) || strEQ(s + 6, op_desc[i]))
  391.             goto found;
  392.             i++;
  393.         }
  394.         goto nonesuch;        /* Should not happen... */
  395.           found:
  396.         oa = opargs[i] >> OASHIFT;
  397.         while (oa) {
  398.             if (oa & OA_OPTIONAL) {
  399.             seen_question = 1;
  400.             str[n++] = ';';
  401.             } else if (seen_question) 
  402.             goto set;    /* XXXX system, exec */
  403.             if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF 
  404.             && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
  405.             str[n++] = '\\';
  406.             }
  407.             /* What to do with R ((un)tie, tied, (sys)read, recv)? */
  408.             str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
  409.             oa = oa >> 4;
  410.         }
  411.         str[n++] = '\0';
  412.         ret = sv_2mortal(newSVpv(str, n - 1));
  413.         } else if (code)        /* Non-Overridable */
  414.         goto set;
  415.         else {            /* None such */
  416.           nonesuch:
  417.         croak("Cannot find an opnumber for \"%s\"", s+6);
  418.         }
  419.     }
  420.     }
  421.     cv = sv_2cv(TOPs, &stash, &gv, FALSE);
  422.     if (cv && SvPOK(cv))
  423.     ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv)));
  424.   set:
  425.     SETs(ret);
  426.     RETURN;
  427. }
  428.  
  429. PP(pp_anoncode)
  430. {
  431.     djSP;
  432.     CV* cv = (CV*)PL_curpad[PL_op->op_targ];
  433.     if (CvCLONE(cv))
  434.     cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
  435.     EXTEND(SP,1);
  436.     PUSHs((SV*)cv);
  437.     RETURN;
  438. }
  439.  
  440. PP(pp_srefgen)
  441. {
  442.     djSP;
  443.     *SP = refto(*SP);
  444.     RETURN;
  445. }
  446.  
  447. PP(pp_refgen)
  448. {
  449.     djSP; dMARK;
  450.     if (GIMME != G_ARRAY) {
  451.     if (++MARK <= SP)
  452.         *MARK = *SP;
  453.     else
  454.         *MARK = &PL_sv_undef;
  455.     *MARK = refto(*MARK);
  456.     SP = MARK;
  457.     RETURN;
  458.     }
  459.     EXTEND_MORTAL(SP - MARK);
  460.     while (++MARK <= SP)
  461.     *MARK = refto(*MARK);
  462.     RETURN;
  463. }
  464.  
  465. STATIC SV*
  466. refto(SV *sv)
  467. {
  468.     SV* rv;
  469.  
  470.     if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
  471.     if (LvTARGLEN(sv))
  472.         vivify_defelem(sv);
  473.     if (!(sv = LvTARG(sv)))
  474.         sv = &PL_sv_undef;
  475.     }
  476.     else if (SvPADTMP(sv))
  477.     sv = newSVsv(sv);
  478.     else {
  479.     SvTEMP_off(sv);
  480.     (void)SvREFCNT_inc(sv);
  481.     }
  482.     rv = sv_newmortal();
  483.     sv_upgrade(rv, SVt_RV);
  484.     SvRV(rv) = sv;
  485.     SvROK_on(rv);
  486.     return rv;
  487. }
  488.  
  489. PP(pp_ref)
  490. {
  491.     djSP; dTARGET;
  492.     SV *sv;
  493.     char *pv;
  494.  
  495.     sv = POPs;
  496.  
  497.     if (sv && SvGMAGICAL(sv))
  498.     mg_get(sv);
  499.  
  500.     if (!sv || !SvROK(sv))
  501.     RETPUSHNO;
  502.  
  503.     sv = SvRV(sv);
  504.     pv = sv_reftype(sv,TRUE);
  505.     PUSHp(pv, strlen(pv));
  506.     RETURN;
  507. }
  508.  
  509. PP(pp_bless)
  510. {
  511.     djSP;
  512.     HV *stash;
  513.  
  514.     if (MAXARG == 1)
  515.     stash = PL_curcop->cop_stash;
  516.     else {
  517.     SV *ssv = POPs;
  518.     STRLEN len;
  519.     char *ptr = SvPV(ssv,len);
  520.     if (PL_dowarn && len == 0)
  521.         warn("Explicit blessing to '' (assuming package main)");
  522.     stash = gv_stashpvn(ptr, len, TRUE);
  523.     }
  524.  
  525.     (void)sv_bless(TOPs, stash);
  526.     RETURN;
  527. }
  528.  
  529. PP(pp_gelem)
  530. {
  531.     GV *gv;
  532.     SV *sv;
  533.     SV *tmpRef;
  534.     char *elem;
  535.     djSP;
  536.  
  537.     sv = POPs;
  538.     elem = SvPV(sv, PL_na);
  539.     gv = (GV*)POPs;
  540.     tmpRef = Nullsv;
  541.     sv = Nullsv;
  542.     switch (elem ? *elem : '\0')
  543.     {
  544.     case 'A':
  545.     if (strEQ(elem, "ARRAY"))
  546.         tmpRef = (SV*)GvAV(gv);
  547.     break;
  548.     case 'C':
  549.     if (strEQ(elem, "CODE"))
  550.         tmpRef = (SV*)GvCVu(gv);
  551.     break;
  552.     case 'F':
  553.     if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
  554.         tmpRef = (SV*)GvIOp(gv);
  555.     break;
  556.     case 'G':
  557.     if (strEQ(elem, "GLOB"))
  558.         tmpRef = (SV*)gv;
  559.     break;
  560.     case 'H':
  561.     if (strEQ(elem, "HASH"))
  562.         tmpRef = (SV*)GvHV(gv);
  563.     break;
  564.     case 'I':
  565.     if (strEQ(elem, "IO"))
  566.         tmpRef = (SV*)GvIOp(gv);
  567.     break;
  568.     case 'N':
  569.     if (strEQ(elem, "NAME"))
  570.         sv = newSVpv(GvNAME(gv), GvNAMELEN(gv));
  571.     break;
  572.     case 'P':
  573.     if (strEQ(elem, "PACKAGE"))
  574.         sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
  575.     break;
  576.     case 'S':
  577.     if (strEQ(elem, "SCALAR"))
  578.         tmpRef = GvSV(gv);
  579.     break;
  580.     }
  581.     if (tmpRef)
  582.     sv = newRV(tmpRef);
  583.     if (sv)
  584.     sv_2mortal(sv);
  585.     else
  586.     sv = &PL_sv_undef;
  587.     XPUSHs(sv);
  588.     RETURN;
  589. }
  590.  
  591. /* Pattern matching */
  592.  
  593. PP(pp_study)
  594. {
  595.     djSP; dPOPss;
  596.     register UNOP *unop = cUNOP;
  597.     register unsigned char *s;
  598.     register I32 pos;
  599.     register I32 ch;
  600.     register I32 *sfirst;
  601.     register I32 *snext;
  602.     STRLEN len;
  603.  
  604.     if (sv == PL_lastscream) {
  605.     if (SvSCREAM(sv))
  606.         RETPUSHYES;
  607.     }
  608.     else {
  609.     if (PL_lastscream) {
  610.         SvSCREAM_off(PL_lastscream);
  611.         SvREFCNT_dec(PL_lastscream);
  612.     }
  613.     PL_lastscream = SvREFCNT_inc(sv);
  614.     }
  615.  
  616.     s = (unsigned char*)(SvPV(sv, len));
  617.     pos = len;
  618.     if (pos <= 0)
  619.     RETPUSHNO;
  620.     if (pos > PL_maxscream) {
  621.     if (PL_maxscream < 0) {
  622.         PL_maxscream = pos + 80;
  623.         New(301, PL_screamfirst, 256, I32);
  624.         New(302, PL_screamnext, PL_maxscream, I32);
  625.     }
  626.     else {
  627.         PL_maxscream = pos + pos / 4;
  628.         Renew(PL_screamnext, PL_maxscream, I32);
  629.     }
  630.     }
  631.  
  632.     sfirst = PL_screamfirst;
  633.     snext = PL_screamnext;
  634.  
  635.     if (!sfirst || !snext)
  636.     DIE("do_study: out of memory");
  637.  
  638.     for (ch = 256; ch; --ch)
  639.     *sfirst++ = -1;
  640.     sfirst -= 256;
  641.  
  642.     while (--pos >= 0) {
  643.     ch = s[pos];
  644.     if (sfirst[ch] >= 0)
  645.         snext[pos] = sfirst[ch] - pos;
  646.     else
  647.         snext[pos] = -pos;
  648.     sfirst[ch] = pos;
  649.     }
  650.  
  651.     SvSCREAM_on(sv);
  652.     sv_magic(sv, Nullsv, 'g', Nullch, 0);    /* piggyback on m//g magic */
  653.     RETPUSHYES;
  654. }
  655.  
  656. PP(pp_trans)
  657. {
  658.     djSP; dTARG;
  659.     SV *sv;
  660.  
  661.     if (PL_op->op_flags & OPf_STACKED)
  662.     sv = POPs;
  663.     else {
  664.     sv = DEFSV;
  665.     EXTEND(SP,1);
  666.     }
  667.     TARG = sv_newmortal();
  668.     PUSHi(do_trans(sv, PL_op));
  669.     RETURN;
  670. }
  671.  
  672. /* Lvalue operators. */
  673.  
  674. PP(pp_schop)
  675. {
  676.     djSP; dTARGET;
  677.     do_chop(TARG, TOPs);
  678.     SETTARG;
  679.     RETURN;
  680. }
  681.  
  682. PP(pp_chop)
  683. {
  684.     djSP; dMARK; dTARGET;
  685.     while (SP > MARK)
  686.     do_chop(TARG, POPs);
  687.     PUSHTARG;
  688.     RETURN;
  689. }
  690.  
  691. PP(pp_schomp)
  692. {
  693.     djSP; dTARGET;
  694.     SETi(do_chomp(TOPs));
  695.     RETURN;
  696. }
  697.  
  698. PP(pp_chomp)
  699. {
  700.     djSP; dMARK; dTARGET;
  701.     register I32 count = 0;
  702.  
  703.     while (SP > MARK)
  704.     count += do_chomp(POPs);
  705.     PUSHi(count);
  706.     RETURN;
  707. }
  708.  
  709. PP(pp_defined)
  710. {
  711.     djSP;
  712.     register SV* sv;
  713.  
  714.     sv = POPs;
  715.     if (!sv || !SvANY(sv))
  716.     RETPUSHNO;
  717.     switch (SvTYPE(sv)) {
  718.     case SVt_PVAV:
  719.     if (AvMAX(sv) >= 0 || SvGMAGICAL(sv))
  720.         RETPUSHYES;
  721.     break;
  722.     case SVt_PVHV:
  723.     if (HvARRAY(sv) || SvGMAGICAL(sv))
  724.         RETPUSHYES;
  725.     break;
  726.     case SVt_PVCV:
  727.     if (CvROOT(sv) || CvXSUB(sv))
  728.         RETPUSHYES;
  729.     break;
  730.     default:
  731.     if (SvGMAGICAL(sv))
  732.         mg_get(sv);
  733.     if (SvOK(sv))
  734.         RETPUSHYES;
  735.     }
  736.     RETPUSHNO;
  737. }
  738.  
  739. PP(pp_undef)
  740. {
  741.     djSP;
  742.     SV *sv;
  743.  
  744.     if (!PL_op->op_private) {
  745.     EXTEND(SP, 1);
  746.     RETPUSHUNDEF;
  747.     }
  748.  
  749.     sv = POPs;
  750.     if (!sv)
  751.     RETPUSHUNDEF;
  752.  
  753.     if (SvTHINKFIRST(sv)) {
  754.     if (SvREADONLY(sv))
  755.         RETPUSHUNDEF;
  756.     if (SvROK(sv))
  757.         sv_unref(sv);
  758.     }
  759.  
  760.     switch (SvTYPE(sv)) {
  761.     case SVt_NULL:
  762.     break;
  763.     case SVt_PVAV:
  764.     av_undef((AV*)sv);
  765.     break;
  766.     case SVt_PVHV:
  767.     hv_undef((HV*)sv);
  768.     break;
  769.     case SVt_PVCV:
  770.     if (PL_dowarn && cv_const_sv((CV*)sv))
  771.         warn("Constant subroutine %s undefined",
  772.          CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
  773.     /* FALL THROUGH */
  774.     case SVt_PVFM:
  775.     { GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv));
  776.       cv_undef((CV*)sv);
  777.       CvGV((CV*)sv) = gv; }   /* let user-undef'd sub keep its identity */
  778.     break;
  779.     case SVt_PVGV:
  780.     if (SvFAKE(sv))
  781.         SvSetMagicSV(sv, &PL_sv_undef);
  782.     else {
  783.         GP *gp;
  784.         gp_free((GV*)sv);
  785.         Newz(602, gp, 1, GP);
  786.         GvGP(sv) = gp_ref(gp);
  787.         GvSV(sv) = NEWSV(72,0);
  788.         GvLINE(sv) = PL_curcop->cop_line;
  789.         GvEGV(sv) = (GV*)sv;
  790.         GvMULTI_on(sv);
  791.     }
  792.     break;
  793.     default:
  794.     if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
  795.         (void)SvOOK_off(sv);
  796.         Safefree(SvPVX(sv));
  797.         SvPV_set(sv, Nullch);
  798.         SvLEN_set(sv, 0);
  799.     }
  800.     (void)SvOK_off(sv);
  801.     SvSETMAGIC(sv);
  802.     }
  803.  
  804.     RETPUSHUNDEF;
  805. }
  806.  
  807. PP(pp_predec)
  808. {
  809.     djSP;
  810.     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
  811.     croak(no_modify);
  812.     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
  813.         SvIVX(TOPs) != IV_MIN)
  814.     {
  815.     --SvIVX(TOPs);
  816.     SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
  817.     }
  818.     else
  819.     sv_dec(TOPs);
  820.     SvSETMAGIC(TOPs);
  821.     return NORMAL;
  822. }
  823.  
  824. PP(pp_postinc)
  825. {
  826.     djSP; dTARGET;
  827.     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
  828.     croak(no_modify);
  829.     sv_setsv(TARG, TOPs);
  830.     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
  831.         SvIVX(TOPs) != IV_MAX)
  832.     {
  833.     ++SvIVX(TOPs);
  834.     SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
  835.     }
  836.     else
  837.     sv_inc(TOPs);
  838.     SvSETMAGIC(TOPs);
  839.     if (!SvOK(TARG))
  840.     sv_setiv(TARG, 0);
  841.     SETs(TARG);
  842.     return NORMAL;
  843. }
  844.  
  845. PP(pp_postdec)
  846. {
  847.     djSP; dTARGET;
  848.     if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
  849.     croak(no_modify);
  850.     sv_setsv(TARG, TOPs);
  851.     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
  852.         SvIVX(TOPs) != IV_MIN)
  853.     {
  854.     --SvIVX(TOPs);
  855.     SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
  856.     }
  857.     else
  858.     sv_dec(TOPs);
  859.     SvSETMAGIC(TOPs);
  860.     SETs(TARG);
  861.     return NORMAL;
  862. }
  863.  
  864. /* Ordinary operators. */
  865.  
  866. PP(pp_pow)
  867. {
  868.     djSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
  869.     {
  870.       dPOPTOPnnrl;
  871.       SETn( pow( left, right) );
  872.       RETURN;
  873.     }
  874. }
  875.  
  876. PP(pp_multiply)
  877. {
  878.     djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
  879.     {
  880.       dPOPTOPnnrl;
  881.       SETn( left * right );
  882.       RETURN;
  883.     }
  884. }
  885.  
  886. PP(pp_divide)
  887. {
  888.     djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
  889.     {
  890.       dPOPPOPnnrl;
  891.       double value;
  892.       if (right == 0.0)
  893.     DIE("Illegal division by zero");
  894. #ifdef SLOPPYDIVIDE
  895.       /* insure that 20./5. == 4. */
  896.       {
  897.     IV k;
  898.     if ((double)I_V(left)  == left &&
  899.         (double)I_V(right) == right &&
  900.         (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
  901.         value = k;
  902.     } else {
  903.         value = left / right;
  904.     }
  905.       }
  906. #else
  907.       value = left / right;
  908. #endif
  909.       PUSHn( value );
  910.       RETURN;
  911.     }
  912. }
  913.  
  914. PP(pp_modulo)
  915. {
  916.     djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
  917.     {
  918.       UV left;
  919.       UV right;
  920.       bool left_neg;
  921.       bool right_neg;
  922.       UV ans;
  923.  
  924.       if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
  925.     IV i = SvIVX(POPs);
  926.     right = (right_neg = (i < 0)) ? -i : i;
  927.       }
  928.       else {
  929.     double n = POPn;
  930.     right = U_V((right_neg = (n < 0)) ? -n : n);
  931.       }
  932.  
  933.       if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
  934.     IV i = SvIVX(POPs);
  935.     left = (left_neg = (i < 0)) ? -i : i;
  936.       }
  937.       else {
  938.     double n = POPn;
  939.     left = U_V((left_neg = (n < 0)) ? -n : n);
  940.       }
  941.  
  942.       if (!right)
  943.     DIE("Illegal modulus zero");
  944.  
  945.       ans = left % right;
  946.       if ((left_neg != right_neg) && ans)
  947.     ans = right - ans;
  948.       if (right_neg) {
  949.     /* XXX may warn: unary minus operator applied to unsigned type */
  950.     /* could change -foo to be (~foo)+1 instead    */
  951.     if (ans <= ~((UV)IV_MAX)+1)
  952.       sv_setiv(TARG, ~ans+1);
  953.     else
  954.       sv_setnv(TARG, -(double)ans);
  955.       }
  956.       else
  957.     sv_setuv(TARG, ans);
  958.       PUSHTARG;
  959.       RETURN;
  960.     }
  961. }
  962.  
  963. PP(pp_repeat)
  964. {
  965.   djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
  966.   {
  967.     register I32 count = POPi;
  968.     if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
  969.     dMARK;
  970.     I32 items = SP - MARK;
  971.     I32 max;
  972.  
  973.     max = items * count;
  974.     MEXTEND(MARK, max);
  975.     if (count > 1) {
  976.         while (SP > MARK) {
  977.         if (*SP)
  978.             SvTEMP_off((*SP));
  979.         SP--;
  980.         }
  981.         MARK++;
  982.         repeatcpy((char*)(MARK + items), (char*)MARK,
  983.         items * sizeof(SV*), count - 1);
  984.         SP += max;
  985.     }
  986.     else if (count <= 0)
  987.         SP -= items;
  988.     }
  989.     else {    /* Note: mark already snarfed by pp_list */
  990.     SV *tmpstr;
  991.     STRLEN len;
  992.  
  993.     tmpstr = POPs;
  994.     if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
  995.         if (SvREADONLY(tmpstr) && PL_curcop != &PL_compiling)
  996.         DIE("Can't x= to readonly value");
  997.         if (SvROK(tmpstr))
  998.         sv_unref(tmpstr);
  999.     }
  1000.     SvSetSV(TARG, tmpstr);
  1001.     SvPV_force(TARG, len);
  1002.     if (count != 1) {
  1003.         if (count < 1)
  1004.         SvCUR_set(TARG, 0);
  1005.         else {
  1006.         SvGROW(TARG, (count * len) + 1);
  1007.         repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
  1008.         SvCUR(TARG) *= count;
  1009.         }
  1010.         *SvEND(TARG) = '\0';
  1011.     }
  1012.     (void)SvPOK_only(TARG);
  1013.     PUSHTARG;
  1014.     }
  1015.     RETURN;
  1016.   }
  1017. }
  1018.  
  1019. PP(pp_subtract)
  1020. {
  1021.     djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
  1022.     {
  1023.       dPOPTOPnnrl_ul;
  1024.       SETn( left - right );
  1025.       RETURN;
  1026.     }
  1027. }
  1028.  
  1029. PP(pp_left_shift)
  1030. {
  1031.     djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
  1032.     {
  1033.       IBW shift = POPi;
  1034.       if (PL_op->op_private & HINT_INTEGER) {
  1035.     IBW i = TOPi;
  1036.     i = BWi(i) << shift;
  1037.     SETi(BWi(i));
  1038.       }
  1039.       else {
  1040.     UBW u = TOPu;
  1041.     u <<= shift;
  1042.     SETu(BWu(u));
  1043.       }
  1044.       RETURN;
  1045.     }
  1046. }
  1047.  
  1048. PP(pp_right_shift)
  1049. {
  1050.     djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
  1051.     {
  1052.       IBW shift = POPi;
  1053.       if (PL_op->op_private & HINT_INTEGER) {
  1054.     IBW i = TOPi;
  1055.     i = BWi(i) >> shift;
  1056.     SETi(BWi(i));
  1057.       }
  1058.       else {
  1059.     UBW u = TOPu;
  1060.     u >>= shift;
  1061.     SETu(BWu(u));
  1062.       }
  1063.       RETURN;
  1064.     }
  1065. }
  1066.  
  1067. PP(pp_lt)
  1068. {
  1069.     djSP; tryAMAGICbinSET(lt,0);
  1070.     {
  1071.       dPOPnv;
  1072.       SETs(boolSV(TOPn < value));
  1073.       RETURN;
  1074.     }
  1075. }
  1076.  
  1077. PP(pp_gt)
  1078. {
  1079.     djSP; tryAMAGICbinSET(gt,0);
  1080.     {
  1081.       dPOPnv;
  1082.       SETs(boolSV(TOPn > value));
  1083.       RETURN;
  1084.     }
  1085. }
  1086.  
  1087. PP(pp_le)
  1088. {
  1089.     djSP; tryAMAGICbinSET(le,0);
  1090.     {
  1091.       dPOPnv;
  1092.       SETs(boolSV(TOPn <= value));
  1093.       RETURN;
  1094.     }
  1095. }
  1096.  
  1097. PP(pp_ge)
  1098. {
  1099.     djSP; tryAMAGICbinSET(ge,0);
  1100.     {
  1101.       dPOPnv;
  1102.       SETs(boolSV(TOPn >= value));
  1103.       RETURN;
  1104.     }
  1105. }
  1106.  
  1107. PP(pp_ne)
  1108. {
  1109.     djSP; tryAMAGICbinSET(ne,0);
  1110.     {
  1111.       dPOPnv;
  1112.       SETs(boolSV(TOPn != value));
  1113.       RETURN;
  1114.     }
  1115. }
  1116.  
  1117. PP(pp_ncmp)
  1118. {
  1119.     djSP; dTARGET; tryAMAGICbin(ncmp,0);
  1120.     {
  1121.       dPOPTOPnnrl;
  1122.       I32 value;
  1123.  
  1124.       if (left == right)
  1125.     value = 0;
  1126.       else if (left < right)
  1127.     value = -1;
  1128.       else if (left > right)
  1129.     value = 1;
  1130.       else {
  1131.     SETs(&PL_sv_undef);
  1132.     RETURN;
  1133.       }
  1134.       SETi(value);
  1135.       RETURN;
  1136.     }
  1137. }
  1138.  
  1139. PP(pp_slt)
  1140. {
  1141.     djSP; tryAMAGICbinSET(slt,0);
  1142.     {
  1143.       dPOPTOPssrl;
  1144.       int cmp = ((PL_op->op_private & OPpLOCALE)
  1145.          ? sv_cmp_locale(left, right)
  1146.          : sv_cmp(left, right));
  1147.       SETs(boolSV(cmp < 0));
  1148.       RETURN;
  1149.     }
  1150. }
  1151.  
  1152. PP(pp_sgt)
  1153. {
  1154.     djSP; tryAMAGICbinSET(sgt,0);
  1155.     {
  1156.       dPOPTOPssrl;
  1157.       int cmp = ((PL_op->op_private & OPpLOCALE)
  1158.          ? sv_cmp_locale(left, right)
  1159.          : sv_cmp(left, right));
  1160.       SETs(boolSV(cmp > 0));
  1161.       RETURN;
  1162.     }
  1163. }
  1164.  
  1165. PP(pp_sle)
  1166. {
  1167.     djSP; tryAMAGICbinSET(sle,0);
  1168.     {
  1169.       dPOPTOPssrl;
  1170.       int cmp = ((PL_op->op_private & OPpLOCALE)
  1171.          ? sv_cmp_locale(left, right)
  1172.          : sv_cmp(left, right));
  1173.       SETs(boolSV(cmp <= 0));
  1174.       RETURN;
  1175.     }
  1176. }
  1177.  
  1178. PP(pp_sge)
  1179. {
  1180.     djSP; tryAMAGICbinSET(sge,0);
  1181.     {
  1182.       dPOPTOPssrl;
  1183.       int cmp = ((PL_op->op_private & OPpLOCALE)
  1184.          ? sv_cmp_locale(left, right)
  1185.          : sv_cmp(left, right));
  1186.       SETs(boolSV(cmp >= 0));
  1187.       RETURN;
  1188.     }
  1189. }
  1190.  
  1191. PP(pp_seq)
  1192. {
  1193.     djSP; tryAMAGICbinSET(seq,0);
  1194.     {
  1195.       dPOPTOPssrl;
  1196.       SETs(boolSV(sv_eq(left, right)));
  1197.       RETURN;
  1198.     }
  1199. }
  1200.  
  1201. PP(pp_sne)
  1202. {
  1203.     djSP; tryAMAGICbinSET(sne,0);
  1204.     {
  1205.       dPOPTOPssrl;
  1206.       SETs(boolSV(!sv_eq(left, right)));
  1207.       RETURN;
  1208.     }
  1209. }
  1210.  
  1211. PP(pp_scmp)
  1212. {
  1213.     djSP; dTARGET;  tryAMAGICbin(scmp,0);
  1214.     {
  1215.       dPOPTOPssrl;
  1216.       int cmp = ((PL_op->op_private & OPpLOCALE)
  1217.          ? sv_cmp_locale(left, right)
  1218.          : sv_cmp(left, right));
  1219.       SETi( cmp );
  1220.       RETURN;
  1221.     }
  1222. }
  1223.  
  1224. PP(pp_bit_and)
  1225. {
  1226.     djSP; dATARGET; tryAMAGICbin(band,opASSIGN);
  1227.     {
  1228.       dPOPTOPssrl;
  1229.       if (SvNIOKp(left) || SvNIOKp(right)) {
  1230.     if (PL_op->op_private & HINT_INTEGER) {
  1231.       IBW value = SvIV(left) & SvIV(right);
  1232.       SETi(BWi(value));
  1233.     }
  1234.     else {
  1235.       UBW value = SvUV(left) & SvUV(right);
  1236.       SETu(BWu(value));
  1237.     }
  1238.       }
  1239.       else {
  1240.     do_vop(PL_op->op_type, TARG, left, right);
  1241.     SETTARG;
  1242.       }
  1243.       RETURN;
  1244.     }
  1245. }
  1246.  
  1247. PP(pp_bit_xor)
  1248. {
  1249.     djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
  1250.     {
  1251.       dPOPTOPssrl;
  1252.       if (SvNIOKp(left) || SvNIOKp(right)) {
  1253.     if (PL_op->op_private & HINT_INTEGER) {
  1254.       IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
  1255.       SETi(BWi(value));
  1256.     }
  1257.     else {
  1258.       UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
  1259.       SETu(BWu(value));
  1260.     }
  1261.       }
  1262.       else {
  1263.     do_vop(PL_op->op_type, TARG, left, right);
  1264.     SETTARG;
  1265.       }
  1266.       RETURN;
  1267.     }
  1268. }
  1269.  
  1270. PP(pp_bit_or)
  1271. {
  1272.     djSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
  1273.     {
  1274.       dPOPTOPssrl;
  1275.       if (SvNIOKp(left) || SvNIOKp(right)) {
  1276.     if (PL_op->op_private & HINT_INTEGER) {
  1277.       IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
  1278.       SETi(BWi(value));
  1279.     }
  1280.     else {
  1281.       UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
  1282.       SETu(BWu(value));
  1283.     }
  1284.       }
  1285.       else {
  1286.     do_vop(PL_op->op_type, TARG, left, right);
  1287.     SETTARG;
  1288.       }
  1289.       RETURN;
  1290.     }
  1291. }
  1292.  
  1293. PP(pp_negate)
  1294. {
  1295.     djSP; dTARGET; tryAMAGICun(neg);
  1296.     {
  1297.     dTOPss;
  1298.     if (SvGMAGICAL(sv))
  1299.         mg_get(sv);
  1300.     if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN)
  1301.         SETi(-SvIVX(sv));
  1302.     else if (SvNIOKp(sv))
  1303.         SETn(-SvNV(sv));
  1304.     else if (SvPOKp(sv)) {
  1305.         STRLEN len;
  1306.         char *s = SvPV(sv, len);
  1307.         if (isIDFIRST(*s)) {
  1308.         sv_setpvn(TARG, "-", 1);
  1309.         sv_catsv(TARG, sv);
  1310.         }
  1311.         else if (*s == '+' || *s == '-') {
  1312.         sv_setsv(TARG, sv);
  1313.         *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
  1314.         }
  1315.         else
  1316.         sv_setnv(TARG, -SvNV(sv));
  1317.         SETTARG;
  1318.     }
  1319.     else
  1320.         SETn(-SvNV(sv));
  1321.     }
  1322.     RETURN;
  1323. }
  1324.  
  1325. PP(pp_not)
  1326. {
  1327. #ifdef OVERLOAD
  1328.     djSP; tryAMAGICunSET(not);
  1329. #endif /* OVERLOAD */
  1330.     *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
  1331.     return NORMAL;
  1332. }
  1333.  
  1334. PP(pp_complement)
  1335. {
  1336.     djSP; dTARGET; tryAMAGICun(compl);
  1337.     {
  1338.       dTOPss;
  1339.       if (SvNIOKp(sv)) {
  1340.     if (PL_op->op_private & HINT_INTEGER) {
  1341.       IBW value = ~SvIV(sv);
  1342.       SETi(BWi(value));
  1343.     }
  1344.     else {
  1345.       UBW value = ~SvUV(sv);
  1346.       SETu(BWu(value));
  1347.     }
  1348.       }
  1349.       else {
  1350.     register char *tmps;
  1351.     register long *tmpl;
  1352.     register I32 anum;
  1353.     STRLEN len;
  1354.  
  1355.     SvSetSV(TARG, sv);
  1356.     tmps = SvPV_force(TARG, len);
  1357.     anum = len;
  1358. #ifdef LIBERAL
  1359.     for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
  1360.         *tmps = ~*tmps;
  1361.     tmpl = (long*)tmps;
  1362.     for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
  1363.         *tmpl = ~*tmpl;
  1364.     tmps = (char*)tmpl;
  1365. #endif
  1366.     for ( ; anum > 0; anum--, tmps++)
  1367.         *tmps = ~*tmps;
  1368.  
  1369.     SETs(TARG);
  1370.       }
  1371.       RETURN;
  1372.     }
  1373. }
  1374.  
  1375. /* integer versions of some of the above */
  1376.  
  1377. PP(pp_i_multiply)
  1378. {
  1379.     djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
  1380.     {
  1381.       dPOPTOPiirl;
  1382.       SETi( left * right );
  1383.       RETURN;
  1384.     }
  1385. }
  1386.  
  1387. PP(pp_i_divide)
  1388. {
  1389.     djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
  1390.     {
  1391.       dPOPiv;
  1392.       if (value == 0)
  1393.     DIE("Illegal division by zero");
  1394.       value = POPi / value;
  1395.       PUSHi( value );
  1396.       RETURN;
  1397.     }
  1398. }
  1399.  
  1400. PP(pp_i_modulo)
  1401. {
  1402.     djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); 
  1403.     {
  1404.       dPOPTOPiirl;
  1405.       if (!right)
  1406.     DIE("Illegal modulus zero");
  1407.       SETi( left % right );
  1408.       RETURN;
  1409.     }
  1410. }
  1411.  
  1412. PP(pp_i_add)
  1413. {
  1414.     djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
  1415.     {
  1416.       dPOPTOPiirl;
  1417.       SETi( left + right );
  1418.       RETURN;
  1419.     }
  1420. }
  1421.  
  1422. PP(pp_i_subtract)
  1423. {
  1424.     djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
  1425.     {
  1426.       dPOPTOPiirl;
  1427.       SETi( left - right );
  1428.       RETURN;
  1429.     }
  1430. }
  1431.  
  1432. PP(pp_i_lt)
  1433. {
  1434.     djSP; tryAMAGICbinSET(lt,0);
  1435.     {
  1436.       dPOPTOPiirl;
  1437.       SETs(boolSV(left < right));
  1438.       RETURN;
  1439.     }
  1440. }
  1441.  
  1442. PP(pp_i_gt)
  1443. {
  1444.     djSP; tryAMAGICbinSET(gt,0);
  1445.     {
  1446.       dPOPTOPiirl;
  1447.       SETs(boolSV(left > right));
  1448.       RETURN;
  1449.     }
  1450. }
  1451.  
  1452. PP(pp_i_le)
  1453. {
  1454.     djSP; tryAMAGICbinSET(le,0);
  1455.     {
  1456.       dPOPTOPiirl;
  1457.       SETs(boolSV(left <= right));
  1458.       RETURN;
  1459.     }
  1460. }
  1461.  
  1462. PP(pp_i_ge)
  1463. {
  1464.     djSP; tryAMAGICbinSET(ge,0);
  1465.     {
  1466.       dPOPTOPiirl;
  1467.       SETs(boolSV(left >= right));
  1468.       RETURN;
  1469.     }
  1470. }
  1471.  
  1472. PP(pp_i_eq)
  1473. {
  1474.     djSP; tryAMAGICbinSET(eq,0);
  1475.     {
  1476.       dPOPTOPiirl;
  1477.       SETs(boolSV(left == right));
  1478.       RETURN;
  1479.     }
  1480. }
  1481.  
  1482. PP(pp_i_ne)
  1483. {
  1484.     djSP; tryAMAGICbinSET(ne,0);
  1485.     {
  1486.       dPOPTOPiirl;
  1487.       SETs(boolSV(left != right));
  1488.       RETURN;
  1489.     }
  1490. }
  1491.  
  1492. PP(pp_i_ncmp)
  1493. {
  1494.     djSP; dTARGET; tryAMAGICbin(ncmp,0);
  1495.     {
  1496.       dPOPTOPiirl;
  1497.       I32 value;
  1498.  
  1499.       if (left > right)
  1500.     value = 1;
  1501.       else if (left < right)
  1502.     value = -1;
  1503.       else
  1504.     value = 0;
  1505.       SETi(value);
  1506.       RETURN;
  1507.     }
  1508. }
  1509.  
  1510. PP(pp_i_negate)
  1511. {
  1512.     djSP; dTARGET; tryAMAGICun(neg);
  1513.     SETi(-TOPi);
  1514.     RETURN;
  1515. }
  1516.  
  1517. /* High falutin' math. */
  1518.  
  1519. PP(pp_atan2)
  1520. {
  1521.     djSP; dTARGET; tryAMAGICbin(atan2,0);
  1522.     {
  1523.       dPOPTOPnnrl;
  1524.       SETn(atan2(left, right));
  1525.       RETURN;
  1526.     }
  1527. }
  1528.  
  1529. PP(pp_sin)
  1530. {
  1531.     djSP; dTARGET; tryAMAGICun(sin);
  1532.     {
  1533.       double value;
  1534.       value = POPn;
  1535.       value = sin(value);
  1536.       XPUSHn(value);
  1537.       RETURN;
  1538.     }
  1539. }
  1540.  
  1541. PP(pp_cos)
  1542. {
  1543.     djSP; dTARGET; tryAMAGICun(cos);
  1544.     {
  1545.       double value;
  1546.       value = POPn;
  1547.       value = cos(value);
  1548.       XPUSHn(value);
  1549.       RETURN;
  1550.     }
  1551. }
  1552.  
  1553. /* Support Configure command-line overrides for rand() functions.
  1554.    After 5.005, perhaps we should replace this by Configure support
  1555.    for drand48(), random(), or rand().  For 5.005, though, maintain
  1556.    compatibility by calling rand() but allow the user to override it.
  1557.    See INSTALL for details.  --Andy Dougherty  15 July 1998
  1558. */
  1559. #ifndef my_rand
  1560. #  define my_rand    rand
  1561. #endif
  1562. #ifndef my_srand
  1563. #  define my_srand    srand
  1564. #endif
  1565.  
  1566. PP(pp_rand)
  1567. {
  1568.     djSP; dTARGET;
  1569.     double value;
  1570.     if (MAXARG < 1)
  1571.     value = 1.0;
  1572.     else
  1573.     value = POPn;
  1574.     if (value == 0.0)
  1575.     value = 1.0;
  1576.     if (!srand_called) {
  1577.     (void)my_srand((unsigned)seed());
  1578.     srand_called = TRUE;
  1579.     }
  1580. #if RANDBITS == 31
  1581.     value = my_rand() * value / 2147483648.0;
  1582. #else
  1583. #if RANDBITS == 16
  1584.     value = my_rand() * value / 65536.0;
  1585. #else
  1586. #if RANDBITS == 15
  1587.     value = my_rand() * value / 32768.0;
  1588. #else
  1589.     value = my_rand() * value / (double)(((unsigned long)1) << RANDBITS);
  1590. #endif
  1591. #endif
  1592. #endif
  1593.     XPUSHn(value);
  1594.     RETURN;
  1595. }
  1596.  
  1597. PP(pp_srand)
  1598. {
  1599.     djSP;
  1600.     UV anum;
  1601.     if (MAXARG < 1)
  1602.     anum = seed();
  1603.     else
  1604.     anum = POPu;
  1605.     (void)my_srand((unsigned)anum);
  1606.     srand_called = TRUE;
  1607.     EXTEND(SP, 1);
  1608.     RETPUSHYES;
  1609. }
  1610.  
  1611. STATIC U32
  1612. seed(void)
  1613. {
  1614.     /*
  1615.      * This is really just a quick hack which grabs various garbage
  1616.      * values.  It really should be a real hash algorithm which
  1617.      * spreads the effect of every input bit onto every output bit,
  1618.      * if someone who knows about such tings would bother to write it.
  1619.      * Might be a good idea to add that function to CORE as well.
  1620.      * No numbers below come from careful analysis or anyting here,
  1621.      * except they are primes and SEED_C1 > 1E6 to get a full-width
  1622.      * value from (tv_sec * SEED_C1 + tv_usec).  The multipliers should
  1623.      * probably be bigger too.
  1624.      */
  1625. #if RANDBITS > 16
  1626. #  define SEED_C1    1000003
  1627. #define   SEED_C4    73819
  1628. #else
  1629. #  define SEED_C1    25747
  1630. #define   SEED_C4    20639
  1631. #endif
  1632. #define   SEED_C2    3
  1633. #define   SEED_C3    269
  1634. #define   SEED_C5    26107
  1635.  
  1636.     dTHR;
  1637.     U32 u;
  1638. #ifdef VMS
  1639. #  include <starlet.h>
  1640.     /* when[] = (low 32 bits, high 32 bits) of time since epoch
  1641.      * in 100-ns units, typically incremented ever 10 ms.        */
  1642.     unsigned int when[2];
  1643.     _ckvmssts(sys$gettim(when));
  1644.     u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
  1645. #else
  1646. #  ifdef HAS_GETTIMEOFDAY
  1647.     struct timeval when;
  1648.     gettimeofday(&when,(struct timezone *) 0);
  1649.     u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
  1650. #  else
  1651.     Time_t when;
  1652.     (void)time(&when);
  1653.     u = (U32)SEED_C1 * when;
  1654. #  endif
  1655. #endif
  1656.     u += SEED_C3 * (U32)getpid();
  1657.     u += SEED_C4 * (U32)(UV)PL_stack_sp;
  1658. #ifndef PLAN9           /* XXX Plan9 assembler chokes on this; fix needed  */
  1659.     u += SEED_C5 * (U32)(UV)&when;
  1660. #endif
  1661.     return u;
  1662. }
  1663.  
  1664. PP(pp_exp)
  1665. {
  1666.     djSP; dTARGET; tryAMAGICun(exp);
  1667.     {
  1668.       double value;
  1669.       value = POPn;
  1670.       value = exp(value);
  1671.       XPUSHn(value);
  1672.       RETURN;
  1673.     }
  1674. }
  1675.  
  1676. PP(pp_log)
  1677. {
  1678.     djSP; dTARGET; tryAMAGICun(log);
  1679.     {
  1680.       double value;
  1681.       value = POPn;
  1682.       if (value <= 0.0) {
  1683.     SET_NUMERIC_STANDARD();
  1684.     DIE("Can't take log of %g", value);
  1685.       }
  1686.       value = log(value);
  1687.       XPUSHn(value);
  1688.       RETURN;
  1689.     }
  1690. }
  1691.  
  1692. PP(pp_sqrt)
  1693. {
  1694.     djSP; dTARGET; tryAMAGICun(sqrt);
  1695.     {
  1696.       double value;
  1697.       value = POPn;
  1698.       if (value < 0.0) {
  1699.     SET_NUMERIC_STANDARD();
  1700.     DIE("Can't take sqrt of %g", value);
  1701.       }
  1702.       value = sqrt(value);
  1703.       XPUSHn(value);
  1704.       RETURN;
  1705.     }
  1706. }
  1707.  
  1708. PP(pp_int)
  1709. {
  1710.     djSP; dTARGET;
  1711.     {
  1712.       double value = TOPn;
  1713.       IV iv;
  1714.  
  1715.       if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
  1716.     iv = SvIVX(TOPs);
  1717.     SETi(iv);
  1718.       }
  1719.       else {
  1720.     if (value >= 0.0)
  1721.       (void)modf(value, &value);
  1722.     else {
  1723.       (void)modf(-value, &value);
  1724.       value = -value;
  1725.     }
  1726.     iv = I_V(value);
  1727.     if (iv == value)
  1728.       SETi(iv);
  1729.     else
  1730.       SETn(value);
  1731.       }
  1732.     }
  1733.     RETURN;
  1734. }
  1735.  
  1736. PP(pp_abs)
  1737. {
  1738.     djSP; dTARGET; tryAMAGICun(abs);
  1739.     {
  1740.       double value = TOPn;
  1741.       IV iv;
  1742.  
  1743.       if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
  1744.       (iv = SvIVX(TOPs)) != IV_MIN) {
  1745.     if (iv < 0)
  1746.       iv = -iv;
  1747.     SETi(iv);
  1748.       }
  1749.       else {
  1750.     if (value < 0.0)
  1751.         value = -value;
  1752.     SETn(value);
  1753.       }
  1754.     }
  1755.     RETURN;
  1756. }
  1757.  
  1758. PP(pp_hex)
  1759. {
  1760.     djSP; dTARGET;
  1761.     char *tmps;
  1762.     I32 argtype;
  1763.  
  1764.     tmps = POPp;
  1765.     XPUSHu(scan_hex(tmps, 99, &argtype));
  1766.     RETURN;
  1767. }
  1768.  
  1769. PP(pp_oct)
  1770. {
  1771.     djSP; dTARGET;
  1772.     UV value;
  1773.     I32 argtype;
  1774.     char *tmps;
  1775.  
  1776.     tmps = POPp;
  1777.     while (*tmps && isSPACE(*tmps))
  1778.     tmps++;
  1779.     if (*tmps == '0')
  1780.     tmps++;
  1781.     if (*tmps == 'x')
  1782.     value = scan_hex(++tmps, 99, &argtype);
  1783.     else
  1784.     value = scan_oct(tmps, 99, &argtype);
  1785.     XPUSHu(value);
  1786.     RETURN;
  1787. }
  1788.  
  1789. /* String stuff. */
  1790.  
  1791. PP(pp_length)
  1792. {
  1793.     djSP; dTARGET;
  1794.     SETi( sv_len(TOPs) );
  1795.     RETURN;
  1796. }
  1797.  
  1798. PP(pp_substr)
  1799. {
  1800.     djSP; dTARGET;
  1801.     SV *sv;
  1802.     I32 len;
  1803.     STRLEN curlen;
  1804.     I32 pos;
  1805.     I32 rem;
  1806.     I32 fail;
  1807.     I32 lvalue = PL_op->op_flags & OPf_MOD;
  1808.     char *tmps;
  1809.     I32 arybase = PL_curcop->cop_arybase;
  1810.     char *repl = 0;
  1811.     STRLEN repl_len;
  1812.  
  1813.     SvTAINTED_off(TARG);            /* decontaminate */
  1814.     if (MAXARG > 2) {
  1815.     if (MAXARG > 3) {
  1816.         sv = POPs;
  1817.         repl = SvPV(sv, repl_len);
  1818.     }
  1819.     len = POPi;
  1820.     }
  1821.     pos = POPi;
  1822.     sv = POPs;
  1823.     PUTBACK;
  1824.     tmps = SvPV(sv, curlen);
  1825.     if (pos >= arybase) {
  1826.     pos -= arybase;
  1827.     rem = curlen-pos;
  1828.     fail = rem;
  1829.     if (MAXARG > 2) {
  1830.         if (len < 0) {
  1831.         rem += len;
  1832.         if (rem < 0)
  1833.             rem = 0;
  1834.         }
  1835.         else if (rem > len)
  1836.              rem = len;
  1837.     }
  1838.     }
  1839.     else {
  1840.     pos += curlen;
  1841.     if (MAXARG < 3)
  1842.         rem = curlen;
  1843.     else if (len >= 0) {
  1844.         rem = pos+len;
  1845.         if (rem > (I32)curlen)
  1846.         rem = curlen;
  1847.     }
  1848.     else {
  1849.         rem = curlen+len;
  1850.         if (rem < pos)
  1851.         rem = pos;
  1852.     }
  1853.     if (pos < 0)
  1854.         pos = 0;
  1855.     fail = rem;
  1856.     rem -= pos;
  1857.     }
  1858.     if (fail < 0) {
  1859.     if (PL_dowarn || lvalue || repl)
  1860.         warn("substr outside of string");
  1861.     RETPUSHUNDEF;
  1862.     }
  1863.     else {
  1864.     tmps += pos;
  1865.     sv_setpvn(TARG, tmps, rem);
  1866.     if (lvalue) {            /* it's an lvalue! */
  1867.         if (!SvGMAGICAL(sv)) {
  1868.         if (SvROK(sv)) {
  1869.             SvPV_force(sv,PL_na);
  1870.             if (PL_dowarn)
  1871.             warn("Attempt to use reference as lvalue in substr");
  1872.         }
  1873.         if (SvOK(sv))        /* is it defined ? */
  1874.             (void)SvPOK_only(sv);
  1875.         else
  1876.             sv_setpvn(sv,"",0);    /* avoid lexical reincarnation */
  1877.         }
  1878.  
  1879.         if (SvTYPE(TARG) < SVt_PVLV) {
  1880.         sv_upgrade(TARG, SVt_PVLV);
  1881.         sv_magic(TARG, Nullsv, 'x', Nullch, 0);
  1882.         }
  1883.  
  1884.         LvTYPE(TARG) = 'x';
  1885.         if (LvTARG(TARG) != sv) {
  1886.         if (LvTARG(TARG))
  1887.             SvREFCNT_dec(LvTARG(TARG));
  1888.         LvTARG(TARG) = SvREFCNT_inc(sv);
  1889.         }
  1890.         LvTARGOFF(TARG) = pos;
  1891.         LvTARGLEN(TARG) = rem;
  1892.     }
  1893.     else if (repl)
  1894.         sv_insert(sv, pos, rem, repl, repl_len);
  1895.     }
  1896.     SPAGAIN;
  1897.     PUSHs(TARG);        /* avoid SvSETMAGIC here */
  1898.     RETURN;
  1899. }
  1900.  
  1901. PP(pp_vec)
  1902. {
  1903.     djSP; dTARGET;
  1904.     register I32 size = POPi;
  1905.     register I32 offset = POPi;
  1906.     register SV *src = POPs;
  1907.     I32 lvalue = PL_op->op_flags & OPf_MOD;
  1908.     STRLEN srclen;
  1909.     unsigned char *s = (unsigned char*)SvPV(src, srclen);
  1910.     unsigned long retnum;
  1911.     I32 len;
  1912.  
  1913.     SvTAINTED_off(TARG);            /* decontaminate */
  1914.     offset *= size;        /* turn into bit offset */
  1915.     len = (offset + size + 7) / 8;
  1916.     if (offset < 0 || size < 1)
  1917.     retnum = 0;
  1918.     else {
  1919.     if (lvalue) {                      /* it's an lvalue! */
  1920.         if (SvTYPE(TARG) < SVt_PVLV) {
  1921.         sv_upgrade(TARG, SVt_PVLV);
  1922.         sv_magic(TARG, Nullsv, 'v', Nullch, 0);
  1923.         }
  1924.  
  1925.         LvTYPE(TARG) = 'v';
  1926.         if (LvTARG(TARG) != src) {
  1927.         if (LvTARG(TARG))
  1928.             SvREFCNT_dec(LvTARG(TARG));
  1929.         LvTARG(TARG) = SvREFCNT_inc(src);
  1930.         }
  1931.         LvTARGOFF(TARG) = offset;
  1932.         LvTARGLEN(TARG) = size;
  1933.     }
  1934.     if (len > srclen) {
  1935.         if (size <= 8)
  1936.         retnum = 0;
  1937.         else {
  1938.         offset >>= 3;
  1939.         if (size == 16) {
  1940.             if (offset >= srclen)
  1941.             retnum = 0;
  1942.             else
  1943.             retnum = (unsigned long) s[offset] << 8;
  1944.         }
  1945.         else if (size == 32) {
  1946.             if (offset >= srclen)
  1947.             retnum = 0;
  1948.             else if (offset + 1 >= srclen)
  1949.             retnum = (unsigned long) s[offset] << 24;
  1950.             else if (offset + 2 >= srclen)
  1951.             retnum = ((unsigned long) s[offset] << 24) +
  1952.                 ((unsigned long) s[offset + 1] << 16);
  1953.             else
  1954.             retnum = ((unsigned long) s[offset] << 24) +
  1955.                 ((unsigned long) s[offset + 1] << 16) +
  1956.                 (s[offset + 2] << 8);
  1957.         }
  1958.         }
  1959.     }
  1960.     else if (size < 8)
  1961.         retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
  1962.     else {
  1963.         offset >>= 3;
  1964.         if (size == 8)
  1965.         retnum = s[offset];
  1966.         else if (size == 16)
  1967.         retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
  1968.         else if (size == 32)
  1969.         retnum = ((unsigned long) s[offset] << 24) +
  1970.             ((unsigned long) s[offset + 1] << 16) +
  1971.             (s[offset + 2] << 8) + s[offset+3];
  1972.     }
  1973.     }
  1974.  
  1975.     sv_setuv(TARG, (UV)retnum);
  1976.     PUSHs(TARG);
  1977.     RETURN;
  1978. }
  1979.  
  1980. PP(pp_index)
  1981. {
  1982.     djSP; dTARGET;
  1983.     SV *big;
  1984.     SV *little;
  1985.     I32 offset;
  1986.     I32 retval;
  1987.     char *tmps;
  1988.     char *tmps2;
  1989.     STRLEN biglen;
  1990.     I32 arybase = PL_curcop->cop_arybase;
  1991.  
  1992.     if (MAXARG < 3)
  1993.     offset = 0;
  1994.     else
  1995.     offset = POPi - arybase;
  1996.     little = POPs;
  1997.     big = POPs;
  1998.     tmps = SvPV(big, biglen);
  1999.     if (offset < 0)
  2000.     offset = 0;
  2001.     else if (offset > biglen)
  2002.     offset = biglen;
  2003.     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
  2004.       (unsigned char*)tmps + biglen, little, 0)))
  2005.     retval = -1 + arybase;
  2006.     else
  2007.     retval = tmps2 - tmps + arybase;
  2008.     PUSHi(retval);
  2009.     RETURN;
  2010. }
  2011.  
  2012. PP(pp_rindex)
  2013. {
  2014.     djSP; dTARGET;
  2015.     SV *big;
  2016.     SV *little;
  2017.     STRLEN blen;
  2018.     STRLEN llen;
  2019.     SV *offstr;
  2020.     I32 offset;
  2021.     I32 retval;
  2022.     char *tmps;
  2023.     char *tmps2;
  2024.     I32 arybase = PL_curcop->cop_arybase;
  2025.  
  2026.     if (MAXARG >= 3)
  2027.     offstr = POPs;
  2028.     little = POPs;
  2029.     big = POPs;
  2030.     tmps2 = SvPV(little, llen);
  2031.     tmps = SvPV(big, blen);
  2032.     if (MAXARG < 3)
  2033.     offset = blen;
  2034.     else
  2035.     offset = SvIV(offstr) - arybase + llen;
  2036.     if (offset < 0)
  2037.     offset = 0;
  2038.     else if (offset > blen)
  2039.     offset = blen;
  2040.     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
  2041.               tmps2, tmps2 + llen)))
  2042.     retval = -1 + arybase;
  2043.     else
  2044.     retval = tmps2 - tmps + arybase;
  2045.     PUSHi(retval);
  2046.     RETURN;
  2047. }
  2048.  
  2049. PP(pp_sprintf)
  2050. {
  2051.     djSP; dMARK; dORIGMARK; dTARGET;
  2052. #ifdef USE_LOCALE_NUMERIC
  2053.     if (PL_op->op_private & OPpLOCALE)
  2054.     SET_NUMERIC_LOCAL();
  2055.     else
  2056.     SET_NUMERIC_STANDARD();
  2057. #endif
  2058.     do_sprintf(TARG, SP-MARK, MARK+1);
  2059.     TAINT_IF(SvTAINTED(TARG));
  2060.     SP = ORIGMARK;
  2061.     PUSHTARG;
  2062.     RETURN;
  2063. }
  2064.  
  2065. PP(pp_ord)
  2066. {
  2067.     djSP; dTARGET;
  2068.     I32 value;
  2069.     char *tmps;
  2070.  
  2071. #ifndef I286
  2072.     tmps = POPp;
  2073.     value = (I32) (*tmps & 255);
  2074. #else
  2075.     I32 anum;
  2076.     tmps = POPp;
  2077.     anum = (I32) *tmps;
  2078.     value = (I32) (anum & 255);
  2079. #endif
  2080.     XPUSHi(value);
  2081.     RETURN;
  2082. }
  2083.  
  2084. PP(pp_chr)
  2085. {
  2086.     djSP; dTARGET;
  2087.     char *tmps;
  2088.  
  2089.     (void)SvUPGRADE(TARG,SVt_PV);
  2090.     SvGROW(TARG,2);
  2091.     SvCUR_set(TARG, 1);
  2092.     tmps = SvPVX(TARG);
  2093.     *tmps++ = POPi;
  2094.     *tmps = '\0';
  2095.     (void)SvPOK_only(TARG);
  2096.     XPUSHs(TARG);
  2097.     RETURN;
  2098. }
  2099.  
  2100. PP(pp_crypt)
  2101. {
  2102.     djSP; dTARGET; dPOPTOPssrl;
  2103. #ifdef HAS_CRYPT
  2104.     char *tmps = SvPV(left, PL_na);
  2105. #ifdef FCRYPT
  2106.     sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na)));
  2107. #else
  2108.     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, PL_na)));
  2109. #endif
  2110. #else
  2111.     DIE(
  2112.       "The crypt() function is unimplemented due to excessive paranoia.");
  2113. #endif
  2114.     SETs(TARG);
  2115.     RETURN;
  2116. }
  2117.  
  2118. PP(pp_ucfirst)
  2119. {
  2120.     djSP;
  2121.     SV *sv = TOPs;
  2122.     register char *s;
  2123.  
  2124.     if (!SvPADTMP(sv)) {
  2125.     dTARGET;
  2126.     sv_setsv(TARG, sv);
  2127.     sv = TARG;
  2128.     SETs(sv);
  2129.     }
  2130.     s = SvPV_force(sv, PL_na);
  2131.     if (*s) {
  2132.     if (PL_op->op_private & OPpLOCALE) {
  2133.         TAINT;
  2134.         SvTAINTED_on(sv);
  2135.         *s = toUPPER_LC(*s);
  2136.     }
  2137.     else
  2138.         *s = toUPPER(*s);
  2139.     }
  2140.  
  2141.     RETURN;
  2142. }
  2143.  
  2144. PP(pp_lcfirst)
  2145. {
  2146.     djSP;
  2147.     SV *sv = TOPs;
  2148.     register char *s;
  2149.  
  2150.     if (!SvPADTMP(sv)) {
  2151.     dTARGET;
  2152.     sv_setsv(TARG, sv);
  2153.     sv = TARG;
  2154.     SETs(sv);
  2155.     }
  2156.     s = SvPV_force(sv, PL_na);
  2157.     if (*s) {
  2158.     if (PL_op->op_private & OPpLOCALE) {
  2159.         TAINT;
  2160.         SvTAINTED_on(sv);
  2161.         *s = toLOWER_LC(*s);
  2162.     }
  2163.     else
  2164.         *s = toLOWER(*s);
  2165.     }
  2166.  
  2167.     SETs(sv);
  2168.     RETURN;
  2169. }
  2170.  
  2171. PP(pp_uc)
  2172. {
  2173.     djSP;
  2174.     SV *sv = TOPs;
  2175.     register char *s;
  2176.     STRLEN len;
  2177.  
  2178.     if (!SvPADTMP(sv)) {
  2179.     dTARGET;
  2180.     sv_setsv(TARG, sv);
  2181.     sv = TARG;
  2182.     SETs(sv);
  2183.     }
  2184.  
  2185.     s = SvPV_force(sv, len);
  2186.     if (len) {
  2187.     register char *send = s + len;
  2188.  
  2189.     if (PL_op->op_private & OPpLOCALE) {
  2190.         TAINT;
  2191.         SvTAINTED_on(sv);
  2192.         for (; s < send; s++)
  2193.         *s = toUPPER_LC(*s);
  2194.     }
  2195.     else {
  2196.         for (; s < send; s++)
  2197.         *s = toUPPER(*s);
  2198.     }
  2199.     }
  2200.     RETURN;
  2201. }
  2202.  
  2203. PP(pp_lc)
  2204. {
  2205.     djSP;
  2206.     SV *sv = TOPs;
  2207.     register char *s;
  2208.     STRLEN len;
  2209.  
  2210.     if (!SvPADTMP(sv)) {
  2211.     dTARGET;
  2212.     sv_setsv(TARG, sv);
  2213.     sv = TARG;
  2214.     SETs(sv);
  2215.     }
  2216.  
  2217.     s = SvPV_force(sv, len);
  2218.     if (len) {
  2219.     register char *send = s + len;
  2220.  
  2221.     if (PL_op->op_private & OPpLOCALE) {
  2222.         TAINT;
  2223.         SvTAINTED_on(sv);
  2224.         for (; s < send; s++)
  2225.         *s = toLOWER_LC(*s);
  2226.     }
  2227.     else {
  2228.         for (; s < send; s++)
  2229.         *s = toLOWER(*s);
  2230.     }
  2231.     }
  2232.     RETURN;
  2233. }
  2234.  
  2235. PP(pp_quotemeta)
  2236. {
  2237.     djSP; dTARGET;
  2238.     SV *sv = TOPs;
  2239.     STRLEN len;
  2240.     register char *s = SvPV(sv,len);
  2241.     register char *d;
  2242.  
  2243.     if (len) {
  2244.     (void)SvUPGRADE(TARG, SVt_PV);
  2245.     SvGROW(TARG, (len * 2) + 1);
  2246.     d = SvPVX(TARG);
  2247.     while (len--) {
  2248.         if (!isALNUM(*s))
  2249.         *d++ = '\\';
  2250.         *d++ = *s++;
  2251.     }
  2252.     *d = '\0';
  2253.     SvCUR_set(TARG, d - SvPVX(TARG));
  2254.     (void)SvPOK_only(TARG);
  2255.     }
  2256.     else
  2257.     sv_setpvn(TARG, s, len);
  2258.     SETs(TARG);
  2259.     RETURN;
  2260. }
  2261.  
  2262. /* Arrays. */
  2263.  
  2264. PP(pp_aslice)
  2265. {
  2266.     djSP; dMARK; dORIGMARK;
  2267.     register SV** svp;
  2268.     register AV* av = (AV*)POPs;
  2269.     register I32 lval = PL_op->op_flags & OPf_MOD;
  2270.     I32 arybase = PL_curcop->cop_arybase;
  2271.     I32 elem;
  2272.  
  2273.     if (SvTYPE(av) == SVt_PVAV) {
  2274.     if (lval && PL_op->op_private & OPpLVAL_INTRO) {
  2275.         I32 max = -1;
  2276.         for (svp = MARK + 1; svp <= SP; svp++) {
  2277.         elem = SvIVx(*svp);
  2278.         if (elem > max)
  2279.             max = elem;
  2280.         }
  2281.         if (max > AvMAX(av))
  2282.         av_extend(av, max);
  2283.     }
  2284.     while (++MARK <= SP) {
  2285.         elem = SvIVx(*MARK);
  2286.  
  2287.         if (elem > 0)
  2288.         elem -= arybase;
  2289.         svp = av_fetch(av, elem, lval);
  2290.         if (lval) {
  2291.         if (!svp || *svp == &PL_sv_undef)
  2292.             DIE(no_aelem, elem);
  2293.         if (PL_op->op_private & OPpLVAL_INTRO)
  2294.             save_aelem(av, elem, svp);
  2295.         }
  2296.         *MARK = svp ? *svp : &PL_sv_undef;
  2297.     }
  2298.     }
  2299.     if (GIMME != G_ARRAY) {
  2300.     MARK = ORIGMARK;
  2301.     *++MARK = *SP;
  2302.     SP = MARK;
  2303.     }
  2304.     RETURN;
  2305. }
  2306.  
  2307. /* Associative arrays. */
  2308.  
  2309. PP(pp_each)
  2310. {
  2311.     djSP; dTARGET;
  2312.     HV *hash = (HV*)POPs;
  2313.     HE *entry;
  2314.     I32 gimme = GIMME_V;
  2315.     I32 realhv = (SvTYPE(hash) == SVt_PVHV);
  2316.  
  2317.     PUTBACK;
  2318.     /* might clobber stack_sp */
  2319.     entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
  2320.     SPAGAIN;
  2321.  
  2322.     EXTEND(SP, 2);
  2323.     if (entry) {
  2324.     PUSHs(hv_iterkeysv(entry));    /* won't clobber stack_sp */
  2325.     if (gimme == G_ARRAY) {
  2326.         PUTBACK;
  2327.         /* might clobber stack_sp */
  2328.         sv_setsv(TARG, realhv ?
  2329.              hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry));
  2330.         SPAGAIN;
  2331.         PUSHs(TARG);
  2332.     }
  2333.     }
  2334.     else if (gimme == G_SCALAR)
  2335.     RETPUSHUNDEF;
  2336.  
  2337.     RETURN;
  2338. }
  2339.  
  2340. PP(pp_values)
  2341. {
  2342.     return do_kv(ARGS);
  2343. }
  2344.  
  2345. PP(pp_keys)
  2346. {
  2347.     return do_kv(ARGS);
  2348. }
  2349.  
  2350. PP(pp_delete)
  2351. {
  2352.     djSP;
  2353.     I32 gimme = GIMME_V;
  2354.     I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
  2355.     SV *sv;
  2356.     HV *hv;
  2357.  
  2358.     if (PL_op->op_private & OPpSLICE) {
  2359.     dMARK; dORIGMARK;
  2360.     U32 hvtype;
  2361.     hv = (HV*)POPs;
  2362.     hvtype = SvTYPE(hv);
  2363.     while (++MARK <= SP) {
  2364.         if (hvtype == SVt_PVHV)
  2365.         sv = hv_delete_ent(hv, *MARK, discard, 0);
  2366.         else
  2367.         DIE("Not a HASH reference");
  2368.         *MARK = sv ? sv : &PL_sv_undef;
  2369.     }
  2370.     if (discard)
  2371.         SP = ORIGMARK;
  2372.     else if (gimme == G_SCALAR) {
  2373.         MARK = ORIGMARK;
  2374.         *++MARK = *SP;
  2375.         SP = MARK;
  2376.     }
  2377.     }
  2378.     else {
  2379.     SV *keysv = POPs;
  2380.     hv = (HV*)POPs;
  2381.     if (SvTYPE(hv) == SVt_PVHV)
  2382.         sv = hv_delete_ent(hv, keysv, discard, 0);
  2383.     else
  2384.         DIE("Not a HASH reference");
  2385.     if (!sv)
  2386.         sv = &PL_sv_undef;
  2387.     if (!discard)
  2388.         PUSHs(sv);
  2389.     }
  2390.     RETURN;
  2391. }
  2392.  
  2393. PP(pp_exists)
  2394. {
  2395.     djSP;
  2396.     SV *tmpsv = POPs;
  2397.     HV *hv = (HV*)POPs;
  2398.     if (SvTYPE(hv) == SVt_PVHV) {
  2399.     if (hv_exists_ent(hv, tmpsv, 0))
  2400.         RETPUSHYES;
  2401.     } else if (SvTYPE(hv) == SVt_PVAV) {
  2402.     if (avhv_exists_ent((AV*)hv, tmpsv, 0))
  2403.         RETPUSHYES;
  2404.     } else {
  2405.     DIE("Not a HASH reference");
  2406.     }
  2407.     RETPUSHNO;
  2408. }
  2409.  
  2410. PP(pp_hslice)
  2411. {
  2412.     djSP; dMARK; dORIGMARK;
  2413.     register HV *hv = (HV*)POPs;
  2414.     register I32 lval = PL_op->op_flags & OPf_MOD;
  2415.     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
  2416.  
  2417.     if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
  2418.     DIE("Can't localize pseudo-hash element");
  2419.  
  2420.     if (realhv || SvTYPE(hv) == SVt_PVAV) {
  2421.     while (++MARK <= SP) {
  2422.         SV *keysv = *MARK;
  2423.         SV **svp;
  2424.         if (realhv) {
  2425.         HE *he = hv_fetch_ent(hv, keysv, lval, 0);
  2426.         svp = he ? &HeVAL(he) : 0;
  2427.         } else {
  2428.         svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
  2429.         }
  2430.         if (lval) {
  2431.         if (!svp || *svp == &PL_sv_undef)
  2432.             DIE(no_helem, SvPV(keysv, PL_na));
  2433.         if (PL_op->op_private & OPpLVAL_INTRO)
  2434.             save_helem(hv, keysv, svp);
  2435.         }
  2436.         *MARK = svp ? *svp : &PL_sv_undef;
  2437.     }
  2438.     }
  2439.     if (GIMME != G_ARRAY) {
  2440.     MARK = ORIGMARK;
  2441.     *++MARK = *SP;
  2442.     SP = MARK;
  2443.     }
  2444.     RETURN;
  2445. }
  2446.  
  2447. /* List operators. */
  2448.  
  2449. PP(pp_list)
  2450. {
  2451.     djSP; dMARK;
  2452.     if (GIMME != G_ARRAY) {
  2453.     if (++MARK <= SP)
  2454.         *MARK = *SP;        /* unwanted list, return last item */
  2455.     else
  2456.         *MARK = &PL_sv_undef;
  2457.     SP = MARK;
  2458.     }
  2459.     RETURN;
  2460. }
  2461.  
  2462. PP(pp_lslice)
  2463. {
  2464.     djSP;
  2465.     SV **lastrelem = PL_stack_sp;
  2466.     SV **lastlelem = PL_stack_base + POPMARK;
  2467.     SV **firstlelem = PL_stack_base + POPMARK + 1;
  2468.     register SV **firstrelem = lastlelem + 1;
  2469.     I32 arybase = PL_curcop->cop_arybase;
  2470.     I32 lval = PL_op->op_flags & OPf_MOD;
  2471.     I32 is_something_there = lval;
  2472.  
  2473.     register I32 max = lastrelem - lastlelem;
  2474.     register SV **lelem;
  2475.     register I32 ix;
  2476.  
  2477.     if (GIMME != G_ARRAY) {
  2478.     ix = SvIVx(*lastlelem);
  2479.     if (ix < 0)
  2480.         ix += max;
  2481.     else
  2482.         ix -= arybase;
  2483.     if (ix < 0 || ix >= max)
  2484.         *firstlelem = &PL_sv_undef;
  2485.     else
  2486.         *firstlelem = firstrelem[ix];
  2487.     SP = firstlelem;
  2488.     RETURN;
  2489.     }
  2490.  
  2491.     if (max == 0) {
  2492.     SP = firstlelem - 1;
  2493.     RETURN;
  2494.     }
  2495.  
  2496.     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
  2497.     ix = SvIVx(*lelem);
  2498.     if (ix < 0) {
  2499.         ix += max;
  2500.         if (ix < 0)
  2501.         *lelem = &PL_sv_undef;
  2502.         else if (!(*lelem = firstrelem[ix]))
  2503.         *lelem = &PL_sv_undef;
  2504.     }
  2505.     else {
  2506.         ix -= arybase;
  2507.         if (ix >= max || !(*lelem = firstrelem[ix]))
  2508.         *lelem = &PL_sv_undef;
  2509.     }
  2510.     if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem)))
  2511.         is_something_there = TRUE;
  2512.     }
  2513.     if (is_something_there)
  2514.     SP = lastlelem;
  2515.     else
  2516.     SP = firstlelem - 1;
  2517.     RETURN;
  2518. }
  2519.  
  2520. PP(pp_anonlist)
  2521. {
  2522.     djSP; dMARK; dORIGMARK;
  2523.     I32 items = SP - MARK;
  2524.     SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
  2525.     SP = ORIGMARK;        /* av_make() might realloc stack_sp */
  2526.     XPUSHs(av);
  2527.     RETURN;
  2528. }
  2529.  
  2530. PP(pp_anonhash)
  2531. {
  2532.     djSP; dMARK; dORIGMARK;
  2533.     HV* hv = (HV*)sv_2mortal((SV*)newHV());
  2534.  
  2535.     while (MARK < SP) {
  2536.     SV* key = *++MARK;
  2537.     SV *val = NEWSV(46, 0);
  2538.     if (MARK < SP)
  2539.         sv_setsv(val, *++MARK);
  2540.     else if (PL_dowarn)
  2541.         warn("Odd number of elements in hash assignment");
  2542.     (void)hv_store_ent(hv,key,val,0);
  2543.     }
  2544.     SP = ORIGMARK;
  2545.     XPUSHs((SV*)hv);
  2546.     RETURN;
  2547. }
  2548.  
  2549. PP(pp_splice)
  2550. {
  2551.     djSP; dMARK; dORIGMARK;
  2552.     register AV *ary = (AV*)*++MARK;
  2553.     register SV **src;
  2554.     register SV **dst;
  2555.     register I32 i;
  2556.     register I32 offset;
  2557.     register I32 length;
  2558.     I32 newlen;
  2559.     I32 after;
  2560.     I32 diff;
  2561.     SV **tmparyval = 0;
  2562.     MAGIC *mg;
  2563.  
  2564.     if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
  2565.     *MARK-- = mg->mg_obj;
  2566.     PUSHMARK(MARK);
  2567.     PUTBACK;
  2568.     ENTER;
  2569.     perl_call_method("SPLICE",GIMME_V);
  2570.     LEAVE;
  2571.     SPAGAIN;
  2572.     RETURN;
  2573.     }
  2574.  
  2575.     SP++;
  2576.  
  2577.     if (++MARK < SP) {
  2578.     offset = i = SvIVx(*MARK);
  2579.     if (offset < 0)
  2580.         offset += AvFILLp(ary) + 1;
  2581.     else
  2582.         offset -= PL_curcop->cop_arybase;
  2583.     if (offset < 0)
  2584.         DIE(no_aelem, i);
  2585.     if (++MARK < SP) {
  2586.         length = SvIVx(*MARK++);
  2587.         if (length < 0) {
  2588.         length += AvFILLp(ary) - offset + 1;
  2589.         if (length < 0)
  2590.             length = 0;
  2591.         }
  2592.     }
  2593.     else
  2594.         length = AvMAX(ary) + 1;        /* close enough to infinity */
  2595.     }
  2596.     else {
  2597.     offset = 0;
  2598.     length = AvMAX(ary) + 1;
  2599.     }
  2600.     if (offset > AvFILLp(ary) + 1)
  2601.     offset = AvFILLp(ary) + 1;
  2602.     after = AvFILLp(ary) + 1 - (offset + length);
  2603.     if (after < 0) {                /* not that much array */
  2604.     length += after;            /* offset+length now in array */
  2605.     after = 0;
  2606.     if (!AvALLOC(ary))
  2607.         av_extend(ary, 0);
  2608.     }
  2609.  
  2610.     /* At this point, MARK .. SP-1 is our new LIST */
  2611.  
  2612.     newlen = SP - MARK;
  2613.     diff = newlen - length;
  2614.     if (newlen && !AvREAL(ary)) {
  2615.     if (AvREIFY(ary))
  2616.         av_reify(ary);
  2617.     else
  2618.         assert(AvREAL(ary));        /* would leak, so croak */
  2619.     }
  2620.  
  2621.     if (diff < 0) {                /* shrinking the area */
  2622.     if (newlen) {
  2623.         New(451, tmparyval, newlen, SV*);    /* so remember insertion */
  2624.         Copy(MARK, tmparyval, newlen, SV*);
  2625.     }
  2626.  
  2627.     MARK = ORIGMARK + 1;
  2628.     if (GIMME == G_ARRAY) {            /* copy return vals to stack */
  2629.         MEXTEND(MARK, length);
  2630.         Copy(AvARRAY(ary)+offset, MARK, length, SV*);
  2631.         if (AvREAL(ary)) {
  2632.         EXTEND_MORTAL(length);
  2633.         for (i = length, dst = MARK; i; i--) {
  2634.             sv_2mortal(*dst);    /* free them eventualy */
  2635.             dst++;
  2636.         }
  2637.         }
  2638.         MARK += length - 1;
  2639.     }
  2640.     else {
  2641.         *MARK = AvARRAY(ary)[offset+length-1];
  2642.         if (AvREAL(ary)) {
  2643.         sv_2mortal(*MARK);
  2644.         for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
  2645.             SvREFCNT_dec(*dst++);    /* free them now */
  2646.         }
  2647.     }
  2648.     AvFILLp(ary) += diff;
  2649.  
  2650.     /* pull up or down? */
  2651.  
  2652.     if (offset < after) {            /* easier to pull up */
  2653.         if (offset) {            /* esp. if nothing to pull */
  2654.         src = &AvARRAY(ary)[offset-1];
  2655.         dst = src - diff;        /* diff is negative */
  2656.         for (i = offset; i > 0; i--)    /* can't trust Copy */
  2657.             *dst-- = *src--;
  2658.         }
  2659.         dst = AvARRAY(ary);
  2660.         SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
  2661.         AvMAX(ary) += diff;
  2662.     }
  2663.     else {
  2664.         if (after) {            /* anything to pull down? */
  2665.         src = AvARRAY(ary) + offset + length;
  2666.         dst = src + diff;        /* diff is negative */
  2667.         Move(src, dst, after, SV*);
  2668.         }
  2669.         dst = &AvARRAY(ary)[AvFILLp(ary)+1];
  2670.                         /* avoid later double free */
  2671.     }
  2672.     i = -diff;
  2673.     while (i)
  2674.         dst[--i] = &PL_sv_undef;
  2675.     
  2676.     if (newlen) {
  2677.         for (src = tmparyval, dst = AvARRAY(ary) + offset;
  2678.           newlen; newlen--) {
  2679.         *dst = NEWSV(46, 0);
  2680.         sv_setsv(*dst++, *src++);
  2681.         }
  2682.         Safefree(tmparyval);
  2683.     }
  2684.     }
  2685.     else {                    /* no, expanding (or same) */
  2686.     if (length) {
  2687.         New(452, tmparyval, length, SV*);    /* so remember deletion */
  2688.         Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
  2689.     }
  2690.  
  2691.     if (diff > 0) {                /* expanding */
  2692.  
  2693.         /* push up or down? */
  2694.  
  2695.         if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
  2696.         if (offset) {
  2697.             src = AvARRAY(ary);
  2698.             dst = src - diff;
  2699.             Move(src, dst, offset, SV*);
  2700.         }
  2701.         SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
  2702.         AvMAX(ary) += diff;
  2703.         AvFILLp(ary) += diff;
  2704.         }
  2705.         else {
  2706.         if (AvFILLp(ary) + diff >= AvMAX(ary))    /* oh, well */
  2707.             av_extend(ary, AvFILLp(ary) + diff);
  2708.         AvFILLp(ary) += diff;
  2709.  
  2710.         if (after) {
  2711.             dst = AvARRAY(ary) + AvFILLp(ary);
  2712.             src = dst - diff;
  2713.             for (i = after; i; i--) {
  2714.             *dst-- = *src--;
  2715.             }
  2716.         }
  2717.         }
  2718.     }
  2719.  
  2720.     for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
  2721.         *dst = NEWSV(46, 0);
  2722.         sv_setsv(*dst++, *src++);
  2723.     }
  2724.     MARK = ORIGMARK + 1;
  2725.     if (GIMME == G_ARRAY) {            /* copy return vals to stack */
  2726.         if (length) {
  2727.         Copy(tmparyval, MARK, length, SV*);
  2728.         if (AvREAL(ary)) {
  2729.             EXTEND_MORTAL(length);
  2730.             for (i = length, dst = MARK; i; i--) {
  2731.             sv_2mortal(*dst);    /* free them eventualy */
  2732.             dst++;
  2733.             }
  2734.         }
  2735.         Safefree(tmparyval);
  2736.         }
  2737.         MARK += length - 1;
  2738.     }
  2739.     else if (length--) {
  2740.         *MARK = tmparyval[length];
  2741.         if (AvREAL(ary)) {
  2742.         sv_2mortal(*MARK);
  2743.         while (length-- > 0)
  2744.             SvREFCNT_dec(tmparyval[length]);
  2745.         }
  2746.         Safefree(tmparyval);
  2747.     }
  2748.     else
  2749.         *MARK = &PL_sv_undef;
  2750.     }
  2751.     SP = MARK;
  2752.     RETURN;
  2753. }
  2754.  
  2755. PP(pp_push)
  2756. {
  2757.     djSP; dMARK; dORIGMARK; dTARGET;
  2758.     register AV *ary = (AV*)*++MARK;
  2759.     register SV *sv = &PL_sv_undef;
  2760.     MAGIC *mg;
  2761.  
  2762.     if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
  2763.     *MARK-- = mg->mg_obj;
  2764.     PUSHMARK(MARK);
  2765.     PUTBACK;
  2766.     ENTER;
  2767.     perl_call_method("PUSH",G_SCALAR|G_DISCARD);
  2768.     LEAVE;
  2769.     SPAGAIN;
  2770.     }
  2771.     else {
  2772.     /* Why no pre-extend of ary here ? */
  2773.     for (++MARK; MARK <= SP; MARK++) {
  2774.         sv = NEWSV(51, 0);
  2775.         if (*MARK)
  2776.         sv_setsv(sv, *MARK);
  2777.         av_push(ary, sv);
  2778.     }
  2779.     }
  2780.     SP = ORIGMARK;
  2781.     PUSHi( AvFILL(ary) + 1 );
  2782.     RETURN;
  2783. }
  2784.  
  2785. PP(pp_pop)
  2786. {
  2787.     djSP;
  2788.     AV *av = (AV*)POPs;
  2789.     SV *sv = av_pop(av);
  2790.     if (AvREAL(av))
  2791.     (void)sv_2mortal(sv);
  2792.     PUSHs(sv);
  2793.     RETURN;
  2794. }
  2795.  
  2796. PP(pp_shift)
  2797. {
  2798.     djSP;
  2799.     AV *av = (AV*)POPs;
  2800.     SV *sv = av_shift(av);
  2801.     EXTEND(SP, 1);
  2802.     if (!sv)
  2803.     RETPUSHUNDEF;
  2804.     if (AvREAL(av))
  2805.     (void)sv_2mortal(sv);
  2806.     PUSHs(sv);
  2807.     RETURN;
  2808. }
  2809.  
  2810. PP(pp_unshift)
  2811. {
  2812.     djSP; dMARK; dORIGMARK; dTARGET;
  2813.     register AV *ary = (AV*)*++MARK;
  2814.     register SV *sv;
  2815.     register I32 i = 0;
  2816.     MAGIC *mg;
  2817.  
  2818.     if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
  2819.     *MARK-- = mg->mg_obj;
  2820.     PUSHMARK(MARK);
  2821.     PUTBACK;
  2822.     ENTER;
  2823.     perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD);
  2824.     LEAVE;
  2825.     SPAGAIN;
  2826.     }
  2827.     else {
  2828.     av_unshift(ary, SP - MARK);
  2829.     while (MARK < SP) {
  2830.         sv = NEWSV(27, 0);
  2831.         sv_setsv(sv, *++MARK);
  2832.         (void)av_store(ary, i++, sv);
  2833.     }
  2834.     }
  2835.     SP = ORIGMARK;
  2836.     PUSHi( AvFILL(ary) + 1 );
  2837.     RETURN;
  2838. }
  2839.  
  2840. PP(pp_reverse)
  2841. {
  2842.     djSP; dMARK;
  2843.     register SV *tmp;
  2844.     SV **oldsp = SP;
  2845.  
  2846.     if (GIMME == G_ARRAY) {
  2847.     MARK++;
  2848.     while (MARK < SP) {
  2849.         tmp = *MARK;
  2850.         *MARK++ = *SP;
  2851.         *SP-- = tmp;
  2852.     }
  2853.     SP = oldsp;
  2854.     }
  2855.     else {
  2856.     register char *up;
  2857.     register char *down;
  2858.     register I32 tmp;
  2859.     dTARGET;
  2860.     STRLEN len;
  2861.  
  2862.     if (SP - MARK > 1)
  2863.         do_join(TARG, &PL_sv_no, MARK, SP);
  2864.     else
  2865.         sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
  2866.     up = SvPV_force(TARG, len);
  2867.     if (len > 1) {
  2868.         down = SvPVX(TARG) + len - 1;
  2869.         while (down > up) {
  2870.         tmp = *up;
  2871.         *up++ = *down;
  2872.         *down-- = tmp;
  2873.         }
  2874.         (void)SvPOK_only(TARG);
  2875.     }
  2876.     SP = MARK + 1;
  2877.     SETTARG;
  2878.     }
  2879.     RETURN;
  2880. }
  2881.  
  2882. STATIC SV      *
  2883. mul128(SV *sv, U8 m)
  2884. {
  2885.   STRLEN          len;
  2886.   char           *s = SvPV(sv, len);
  2887.   char           *t;
  2888.   U32             i = 0;
  2889.  
  2890.   if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
  2891.     SV             *tmpNew = newSVpv("0000000000", 10);
  2892.  
  2893.     sv_catsv(tmpNew, sv);
  2894.     SvREFCNT_dec(sv);        /* free old sv */
  2895.     sv = tmpNew;
  2896.     s = SvPV(sv, len);
  2897.   }
  2898.   t = s + len - 1;
  2899.   while (!*t)                   /* trailing '\0'? */
  2900.     t--;
  2901.   while (t > s) {
  2902.     i = ((*t - '0') << 7) + m;
  2903.     *(t--) = '0' + (i % 10);
  2904.     m = i / 10;
  2905.   }
  2906.   return (sv);
  2907. }
  2908.  
  2909. /* Explosives and implosives. */
  2910.  
  2911. PP(pp_unpack)
  2912. {
  2913.     djSP;
  2914.     dPOPPOPssrl;
  2915.     SV **oldsp = SP;
  2916.     I32 gimme = GIMME_V;
  2917.     SV *sv;
  2918.     STRLEN llen;
  2919.     STRLEN rlen;
  2920.     register char *pat = SvPV(left, llen);
  2921.     register char *s = SvPV(right, rlen);
  2922.     char *strend = s + rlen;
  2923.     char *strbeg = s;
  2924.     register char *patend = pat + llen;
  2925.     I32 datumtype;
  2926.     register I32 len;
  2927.     register I32 bits;
  2928.  
  2929.     /* These must not be in registers: */
  2930.     I16 ashort;
  2931.     int aint;
  2932.     I32 along;
  2933. #ifdef HAS_QUAD
  2934.     Quad_t aquad;
  2935. #endif
  2936.     U16 aushort;
  2937.     unsigned int auint;
  2938.     U32 aulong;
  2939. #ifdef HAS_QUAD
  2940.     unsigned Quad_t auquad;
  2941. #endif
  2942.     char *aptr;
  2943.     float afloat;
  2944.     double adouble;
  2945.     I32 checksum = 0;
  2946.     register U32 culong;
  2947.     double cdouble;
  2948.     static char* bitcount = 0;
  2949.     int commas = 0;
  2950.  
  2951.     if (gimme != G_ARRAY) {        /* arrange to do first one only */
  2952.     /*SUPPRESS 530*/
  2953.     for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
  2954.     if (strchr("aAbBhHP", *patend) || *pat == '%') {
  2955.         patend++;
  2956.         while (isDIGIT(*patend) || *patend == '*')
  2957.         patend++;
  2958.     }
  2959.     else
  2960.         patend++;
  2961.     }
  2962.     while (pat < patend) {
  2963.       reparse:
  2964.     datumtype = *pat++ & 0xFF;
  2965.     if (isSPACE(datumtype))
  2966.         continue;
  2967.     if (pat >= patend)
  2968.         len = 1;
  2969.     else if (*pat == '*') {
  2970.         len = strend - strbeg;    /* long enough */
  2971.         pat++;
  2972.     }
  2973.     else if (isDIGIT(*pat)) {
  2974.         len = *pat++ - '0';
  2975.         while (isDIGIT(*pat))
  2976.         len = (len * 10) + (*pat++ - '0');
  2977.     }
  2978.     else
  2979.         len = (datumtype != '@');
  2980.     switch(datumtype) {
  2981.     default:
  2982.         croak("Invalid type in unpack: '%c'", (int)datumtype);
  2983.     case ',': /* grandfather in commas but with a warning */
  2984.         if (commas++ == 0 && PL_dowarn)
  2985.         warn("Invalid type in unpack: '%c'", (int)datumtype);
  2986.         break;
  2987.     case '%':
  2988.         if (len == 1 && pat[-1] != '1')
  2989.         len = 16;
  2990.         checksum = len;
  2991.         culong = 0;
  2992.         cdouble = 0;
  2993.         if (pat < patend)
  2994.         goto reparse;
  2995.         break;
  2996.     case '@':
  2997.         if (len > strend - strbeg)
  2998.         DIE("@ outside of string");
  2999.         s = strbeg + len;
  3000.         break;
  3001.     case 'X':
  3002.         if (len > s - strbeg)
  3003.         DIE("X outside of string");
  3004.         s -= len;
  3005.         break;
  3006.     case 'x':
  3007.         if (len > strend - s)
  3008.         DIE("x outside of string");
  3009.         s += len;
  3010.         break;
  3011.     case 'A':
  3012.     case 'a':
  3013.         if (len > strend - s)
  3014.         len = strend - s;
  3015.         if (checksum)
  3016.         goto uchar_checksum;
  3017.         sv = NEWSV(35, len);
  3018.         sv_setpvn(sv, s, len);
  3019.         s += len;
  3020.         if (datumtype == 'A') {
  3021.         aptr = s;    /* borrow register */
  3022.         s = SvPVX(sv) + len - 1;
  3023.         while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
  3024.             s--;
  3025.         *++s = '\0';
  3026.         SvCUR_set(sv, s - SvPVX(sv));
  3027.         s = aptr;    /* unborrow register */
  3028.         }
  3029.         XPUSHs(sv_2mortal(sv));
  3030.         break;
  3031.     case 'B':
  3032.     case 'b':
  3033.         if (pat[-1] == '*' || len > (strend - s) * 8)
  3034.         len = (strend - s) * 8;
  3035.         if (checksum) {
  3036.         if (!bitcount) {
  3037.             Newz(601, bitcount, 256, char);
  3038.             for (bits = 1; bits < 256; bits++) {
  3039.             if (bits & 1)    bitcount[bits]++;
  3040.             if (bits & 2)    bitcount[bits]++;
  3041.             if (bits & 4)    bitcount[bits]++;
  3042.             if (bits & 8)    bitcount[bits]++;
  3043.             if (bits & 16)    bitcount[bits]++;
  3044.             if (bits & 32)    bitcount[bits]++;
  3045.             if (bits & 64)    bitcount[bits]++;
  3046.             if (bits & 128)    bitcount[bits]++;
  3047.             }
  3048.         }
  3049.         while (len >= 8) {
  3050.             culong += bitcount[*(unsigned char*)s++];
  3051.             len -= 8;
  3052.         }
  3053.         if (len) {
  3054.             bits = *s;
  3055.             if (datumtype == 'b') {
  3056.             while (len-- > 0) {
  3057.                 if (bits & 1) culong++;
  3058.                 bits >>= 1;
  3059.             }
  3060.             }
  3061.             else {
  3062.             while (len-- > 0) {
  3063.                 if (bits & 128) culong++;
  3064.                 bits <<= 1;
  3065.             }
  3066.             }
  3067.         }
  3068.         break;
  3069.         }
  3070.         sv = NEWSV(35, len + 1);
  3071.         SvCUR_set(sv, len);
  3072.         SvPOK_on(sv);
  3073.         aptr = pat;            /* borrow register */
  3074.         pat = SvPVX(sv);
  3075.         if (datumtype == 'b') {
  3076.         aint = len;
  3077.         for (len = 0; len < aint; len++) {
  3078.             if (len & 7)        /*SUPPRESS 595*/
  3079.             bits >>= 1;
  3080.             else
  3081.             bits = *s++;
  3082.             *pat++ = '0' + (bits & 1);
  3083.         }
  3084.         }
  3085.         else {
  3086.         aint = len;
  3087.         for (len = 0; len < aint; len++) {
  3088.             if (len & 7)
  3089.             bits <<= 1;
  3090.             else
  3091.             bits = *s++;
  3092.             *pat++ = '0' + ((bits & 128) != 0);
  3093.         }
  3094.         }
  3095.         *pat = '\0';
  3096.         pat = aptr;            /* unborrow register */
  3097.         XPUSHs(sv_2mortal(sv));
  3098.         break;
  3099.     case 'H':
  3100.     case 'h':
  3101.         if (pat[-1] == '*' || len > (strend - s) * 2)
  3102.         len = (strend - s) * 2;
  3103.         sv = NEWSV(35, len + 1);
  3104.         SvCUR_set(sv, len);
  3105.         SvPOK_on(sv);
  3106.         aptr = pat;            /* borrow register */
  3107.         pat = SvPVX(sv);
  3108.         if (datumtype == 'h') {
  3109.         aint = len;
  3110.         for (len = 0; len < aint; len++) {
  3111.             if (len & 1)
  3112.             bits >>= 4;
  3113.             else
  3114.             bits = *s++;
  3115.             *pat++ = PL_hexdigit[bits & 15];
  3116.         }
  3117.         }
  3118.         else {
  3119.         aint = len;
  3120.         for (len = 0; len < aint; len++) {
  3121.             if (len & 1)
  3122.             bits <<= 4;
  3123.             else
  3124.             bits = *s++;
  3125.             *pat++ = PL_hexdigit[(bits >> 4) & 15];
  3126.         }
  3127.         }
  3128.         *pat = '\0';
  3129.         pat = aptr;            /* unborrow register */
  3130.         XPUSHs(sv_2mortal(sv));
  3131.         break;
  3132.     case 'c':
  3133.         if (len > strend - s)
  3134.         len = strend - s;
  3135.         if (checksum) {
  3136.         while (len-- > 0) {
  3137.             aint = *s++;
  3138.             if (aint >= 128)    /* fake up signed chars */
  3139.             aint -= 256;
  3140.             culong += aint;
  3141.         }
  3142.         }
  3143.         else {
  3144.         EXTEND(SP, len);
  3145.         EXTEND_MORTAL(len);
  3146.         while (len-- > 0) {
  3147.             aint = *s++;
  3148.             if (aint >= 128)    /* fake up signed chars */
  3149.             aint -= 256;
  3150.             sv = NEWSV(36, 0);
  3151.             sv_setiv(sv, (IV)aint);
  3152.             PUSHs(sv_2mortal(sv));
  3153.         }
  3154.         }
  3155.         break;
  3156.     case 'C':
  3157.         if (len > strend - s)
  3158.         len = strend - s;
  3159.         if (checksum) {
  3160.           uchar_checksum:
  3161.         while (len-- > 0) {
  3162.             auint = *s++ & 255;
  3163.             culong += auint;
  3164.         }
  3165.         }
  3166.         else {
  3167.         EXTEND(SP, len);
  3168.         EXTEND_MORTAL(len);
  3169.         while (len-- > 0) {
  3170.             auint = *s++ & 255;
  3171.             sv = NEWSV(37, 0);
  3172.             sv_setiv(sv, (IV)auint);
  3173.             PUSHs(sv_2mortal(sv));
  3174.         }
  3175.         }
  3176.         break;
  3177.     case 's':
  3178.         along = (strend - s) / SIZE16;
  3179.         if (len > along)
  3180.         len = along;
  3181.         if (checksum) {
  3182.         while (len-- > 0) {
  3183.             COPY16(s, &ashort);
  3184.             s += SIZE16;
  3185.             culong += ashort;
  3186.         }
  3187.         }
  3188.         else {
  3189.         EXTEND(SP, len);
  3190.         EXTEND_MORTAL(len);
  3191.         while (len-- > 0) {
  3192.             COPY16(s, &ashort);
  3193.             s += SIZE16;
  3194.             sv = NEWSV(38, 0);
  3195.             sv_setiv(sv, (IV)ashort);
  3196.             PUSHs(sv_2mortal(sv));
  3197.         }
  3198.         }
  3199.         break;
  3200.     case 'v':
  3201.     case 'n':
  3202.     case 'S':
  3203.         along = (strend - s) / SIZE16;
  3204.         if (len > along)
  3205.         len = along;
  3206.         if (checksum) {
  3207.         while (len-- > 0) {
  3208.             COPY16(s, &aushort);
  3209.             s += SIZE16;
  3210. #ifdef HAS_NTOHS
  3211.             if (datumtype == 'n')
  3212.             aushort = PerlSock_ntohs(aushort);
  3213. #endif
  3214. #ifdef HAS_VTOHS
  3215.             if (datumtype == 'v')
  3216.             aushort = vtohs(aushort);
  3217. #endif
  3218.             culong += aushort;
  3219.         }
  3220.         }
  3221.         else {
  3222.         EXTEND(SP, len);
  3223.         EXTEND_MORTAL(len);
  3224.         while (len-- > 0) {
  3225.             COPY16(s, &aushort);
  3226.             s += SIZE16;
  3227.             sv = NEWSV(39, 0);
  3228. #ifdef HAS_NTOHS
  3229.             if (datumtype == 'n')
  3230.             aushort = PerlSock_ntohs(aushort);
  3231. #endif
  3232. #ifdef HAS_VTOHS
  3233.             if (datumtype == 'v')
  3234.             aushort = vtohs(aushort);
  3235. #endif
  3236.             sv_setiv(sv, (IV)aushort);
  3237.             PUSHs(sv_2mortal(sv));
  3238.         }
  3239.         }
  3240.         break;
  3241.     case 'i':
  3242.         along = (strend - s) / sizeof(int);
  3243.         if (len > along)
  3244.         len = along;
  3245.         if (checksum) {
  3246.         while (len-- > 0) {
  3247.             Copy(s, &aint, 1, int);
  3248.             s += sizeof(int);
  3249.             if (checksum > 32)
  3250.             cdouble += (double)aint;
  3251.             else
  3252.             culong += aint;
  3253.         }
  3254.         }
  3255.         else {
  3256.         EXTEND(SP, len);
  3257.         EXTEND_MORTAL(len);
  3258.         while (len-- > 0) {
  3259.             Copy(s, &aint, 1, int);
  3260.             s += sizeof(int);
  3261.             sv = NEWSV(40, 0);
  3262. #ifdef __osf__
  3263.                     /* Without the dummy below unpack("i", pack("i",-1))
  3264.                      * return 0xFFffFFff instead of -1 for Digital Unix V4.0
  3265.                      * cc with optimization turned on */
  3266.                     (aint) ?
  3267.                 sv_setiv(sv, (IV)aint) :
  3268. #endif
  3269.             sv_setiv(sv, (IV)aint);
  3270.             PUSHs(sv_2mortal(sv));
  3271.         }
  3272.         }
  3273.         break;
  3274.     case 'I':
  3275.         along = (strend - s) / sizeof(unsigned int);
  3276.         if (len > along)
  3277.         len = along;
  3278.         if (checksum) {
  3279.         while (len-- > 0) {
  3280.             Copy(s, &auint, 1, unsigned int);
  3281.             s += sizeof(unsigned int);
  3282.             if (checksum > 32)
  3283.             cdouble += (double)auint;
  3284.             else
  3285.             culong += auint;
  3286.         }
  3287.         }
  3288.         else {
  3289.         EXTEND(SP, len);
  3290.         EXTEND_MORTAL(len);
  3291.         while (len-- > 0) {
  3292.             Copy(s, &auint, 1, unsigned int);
  3293.             s += sizeof(unsigned int);
  3294.             sv = NEWSV(41, 0);
  3295.             sv_setuv(sv, (UV)auint);
  3296.             PUSHs(sv_2mortal(sv));
  3297.         }
  3298.         }
  3299.         break;
  3300.     case 'l':
  3301.         along = (strend - s) / SIZE32;
  3302.         if (len > along)
  3303.         len = along;
  3304.         if (checksum) {
  3305.         while (len-- > 0) {
  3306.             COPY32(s, &along);
  3307.             s += SIZE32;
  3308.             if (checksum > 32)
  3309.             cdouble += (double)along;
  3310.             else
  3311.             culong += along;
  3312.         }
  3313.         }
  3314.         else {
  3315.         EXTEND(SP, len);
  3316.         EXTEND_MORTAL(len);
  3317.         while (len-- > 0) {
  3318.             COPY32(s, &along);
  3319.             s += SIZE32;
  3320.             sv = NEWSV(42, 0);
  3321.             sv_setiv(sv, (IV)along);
  3322.             PUSHs(sv_2mortal(sv));
  3323.         }
  3324.         }
  3325.         break;
  3326.     case 'V':
  3327.     case 'N':
  3328.     case 'L':
  3329.         along = (strend - s) / SIZE32;
  3330.         if (len > along)
  3331.         len = along;
  3332.         if (checksum) {
  3333.         while (len-- > 0) {
  3334.             COPY32(s, &aulong);
  3335.             s += SIZE32;
  3336. #ifdef HAS_NTOHL
  3337.             if (datumtype == 'N')
  3338.             aulong = PerlSock_ntohl(aulong);
  3339. #endif
  3340. #ifdef HAS_VTOHL
  3341.             if (datumtype == 'V')
  3342.             aulong = vtohl(aulong);
  3343. #endif
  3344.             if (checksum > 32)
  3345.             cdouble += (double)aulong;
  3346.             else
  3347.             culong += aulong;
  3348.         }
  3349.         }
  3350.         else {
  3351.         EXTEND(SP, len);
  3352.         EXTEND_MORTAL(len);
  3353.         while (len-- > 0) {
  3354.             COPY32(s, &aulong);
  3355.             s += SIZE32;
  3356. #ifdef HAS_NTOHL
  3357.             if (datumtype == 'N')
  3358.             aulong = PerlSock_ntohl(aulong);
  3359. #endif
  3360. #ifdef HAS_VTOHL
  3361.             if (datumtype == 'V')
  3362.             aulong = vtohl(aulong);
  3363. #endif
  3364.             sv = NEWSV(43, 0);
  3365.             sv_setuv(sv, (UV)aulong);
  3366.             PUSHs(sv_2mortal(sv));
  3367.         }
  3368.         }
  3369.         break;
  3370.     case 'p':
  3371.         along = (strend - s) / sizeof(char*);
  3372.         if (len > along)
  3373.         len = along;
  3374.         EXTEND(SP, len);
  3375.         EXTEND_MORTAL(len);
  3376.         while (len-- > 0) {
  3377.         if (sizeof(char*) > strend - s)
  3378.             break;
  3379.         else {
  3380.             Copy(s, &aptr, 1, char*);
  3381.             s += sizeof(char*);
  3382.         }
  3383.         sv = NEWSV(44, 0);
  3384.         if (aptr)
  3385.             sv_setpv(sv, aptr);
  3386.         PUSHs(sv_2mortal(sv));
  3387.         }
  3388.         break;
  3389.     case 'w':
  3390.         EXTEND(SP, len);
  3391.         EXTEND_MORTAL(len);
  3392.         {
  3393.         UV auv = 0;
  3394.         U32 bytes = 0;
  3395.         
  3396.         while ((len > 0) && (s < strend)) {
  3397.             auv = (auv << 7) | (*s & 0x7f);
  3398.             if (!(*s++ & 0x80)) {
  3399.             bytes = 0;
  3400.             sv = NEWSV(40, 0);
  3401.             sv_setuv(sv, auv);
  3402.             PUSHs(sv_2mortal(sv));
  3403.             len--;
  3404.             auv = 0;
  3405.             }
  3406.             else if (++bytes >= sizeof(UV)) {    /* promote to string */
  3407.             char *t;
  3408.  
  3409.             sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
  3410.             while (s < strend) {
  3411.                 sv = mul128(sv, *s & 0x7f);
  3412.                 if (!(*s++ & 0x80)) {
  3413.                 bytes = 0;
  3414.                 break;
  3415.                 }
  3416.             }
  3417.             t = SvPV(sv, PL_na);
  3418.             while (*t == '0')
  3419.                 t++;
  3420.             sv_chop(sv, t);
  3421.             PUSHs(sv_2mortal(sv));
  3422.             len--;
  3423.             auv = 0;
  3424.             }
  3425.         }
  3426.         if ((s >= strend) && bytes)
  3427.             croak("Unterminated compressed integer");
  3428.         }
  3429.         break;
  3430.     case 'P':
  3431.         EXTEND(SP, 1);
  3432.         if (sizeof(char*) > strend - s)
  3433.         break;
  3434.         else {
  3435.         Copy(s, &aptr, 1, char*);
  3436.         s += sizeof(char*);
  3437.         }
  3438.         sv = NEWSV(44, 0);
  3439.         if (aptr)
  3440.         sv_setpvn(sv, aptr, len);
  3441.         PUSHs(sv_2mortal(sv));
  3442.         break;
  3443. #ifdef HAS_QUAD
  3444.     case 'q':
  3445.         along = (strend - s) / sizeof(Quad_t);
  3446.         if (len > along)
  3447.         len = along;
  3448.         EXTEND(SP, len);
  3449.         EXTEND_MORTAL(len);
  3450.         while (len-- > 0) {
  3451.         if (s + sizeof(Quad_t) > strend)
  3452.             aquad = 0;
  3453.         else {
  3454.             Copy(s, &aquad, 1, Quad_t);
  3455.             s += sizeof(Quad_t);
  3456.         }
  3457.         sv = NEWSV(42, 0);
  3458.         if (aquad >= IV_MIN && aquad <= IV_MAX)
  3459.             sv_setiv(sv, (IV)aquad);
  3460.         else
  3461.             sv_setnv(sv, (double)aquad);
  3462.         PUSHs(sv_2mortal(sv));
  3463.         }
  3464.         break;
  3465.     case 'Q':
  3466.         along = (strend - s) / sizeof(Quad_t);
  3467.         if (len > along)
  3468.         len = along;
  3469.         EXTEND(SP, len);
  3470.         EXTEND_MORTAL(len);
  3471.         while (len-- > 0) {
  3472.         if (s + sizeof(unsigned Quad_t) > strend)
  3473.             auquad = 0;
  3474.         else {
  3475.             Copy(s, &auquad, 1, unsigned Quad_t);
  3476.             s += sizeof(unsigned Quad_t);
  3477.         }
  3478.         sv = NEWSV(43, 0);
  3479.         if (auquad <= UV_MAX)
  3480.             sv_setuv(sv, (UV)auquad);
  3481.         else
  3482.             sv_setnv(sv, (double)auquad);
  3483.         PUSHs(sv_2mortal(sv));
  3484.         }
  3485.         break;
  3486. #endif
  3487.     /* float and double added gnb@melba.bby.oz.au 22/11/89 */
  3488.     case 'f':
  3489.     case 'F':
  3490.         along = (strend - s) / sizeof(float);
  3491.         if (len > along)
  3492.         len = along;
  3493.         if (checksum) {
  3494.         while (len-- > 0) {
  3495.             Copy(s, &afloat, 1, float);
  3496.             s += sizeof(float);
  3497.             cdouble += afloat;
  3498.         }
  3499.         }
  3500.         else {
  3501.         EXTEND(SP, len);
  3502.         EXTEND_MORTAL(len);
  3503.         while (len-- > 0) {
  3504.             Copy(s, &afloat, 1, float);
  3505.             s += sizeof(float);
  3506.             sv = NEWSV(47, 0);
  3507.             sv_setnv(sv, (double)afloat);
  3508.             PUSHs(sv_2mortal(sv));
  3509.         }
  3510.         }
  3511.         break;
  3512.     case 'd':
  3513.     case 'D':
  3514.         along = (strend - s) / sizeof(double);
  3515.         if (len > along)
  3516.         len = along;
  3517.         if (checksum) {
  3518.         while (len-- > 0) {
  3519.             Copy(s, &adouble, 1, double);
  3520.             s += sizeof(double);
  3521.             cdouble += adouble;
  3522.         }
  3523.         }
  3524.         else {
  3525.         EXTEND(SP, len);
  3526.         EXTEND_MORTAL(len);
  3527.         while (len-- > 0) {
  3528.             Copy(s, &adouble, 1, double);
  3529.             s += sizeof(double);
  3530.             sv = NEWSV(48, 0);
  3531.             sv_setnv(sv, (double)adouble);
  3532.             PUSHs(sv_2mortal(sv));
  3533.         }
  3534.         }
  3535.         break;
  3536.     case 'u':
  3537.         along = (strend - s) * 3 / 4;
  3538.         sv = NEWSV(42, along);
  3539.         if (along)
  3540.         SvPOK_on(sv);
  3541.         while (s < strend && *s > ' ' && *s < 'a') {
  3542.         I32 a, b, c, d;
  3543.         char hunk[4];
  3544.  
  3545.         hunk[3] = '\0';
  3546.         len = (*s++ - ' ') & 077;
  3547.         while (len > 0) {
  3548.             if (s < strend && *s >= ' ')
  3549.             a = (*s++ - ' ') & 077;
  3550.             else
  3551.             a = 0;
  3552.             if (s < strend && *s >= ' ')
  3553.             b = (*s++ - ' ') & 077;
  3554.             else
  3555.             b = 0;
  3556.             if (s < strend && *s >= ' ')
  3557.             c = (*s++ - ' ') & 077;
  3558.             else
  3559.             c = 0;
  3560.             if (s < strend && *s >= ' ')
  3561.             d = (*s++ - ' ') & 077;
  3562.             else
  3563.             d = 0;
  3564.             hunk[0] = (a << 2) | (b >> 4);
  3565.             hunk[1] = (b << 4) | (c >> 2);
  3566.             hunk[2] = (c << 6) | d;
  3567.             sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
  3568.             len -= 3;
  3569.         }
  3570.         if (*s == '\n')
  3571.             s++;
  3572.         else if (s[1] == '\n')        /* possible checksum byte */
  3573.             s += 2;
  3574.         }
  3575.         XPUSHs(sv_2mortal(sv));
  3576.         break;
  3577.     }
  3578.     if (checksum) {
  3579.         sv = NEWSV(42, 0);
  3580.         if (strchr("fFdD", datumtype) ||
  3581.           (checksum > 32 && strchr("iIlLN", datumtype)) ) {
  3582.         double trouble;
  3583.  
  3584.         adouble = 1.0;
  3585.         while (checksum >= 16) {
  3586.             checksum -= 16;
  3587.             adouble *= 65536.0;
  3588.         }
  3589.         while (checksum >= 4) {
  3590.             checksum -= 4;
  3591.             adouble *= 16.0;
  3592.         }
  3593.         while (checksum--)
  3594.             adouble *= 2.0;
  3595.         along = (1 << checksum) - 1;
  3596.         while (cdouble < 0.0)
  3597.             cdouble += adouble;
  3598.         cdouble = modf(cdouble / adouble, &trouble) * adouble;
  3599.         sv_setnv(sv, cdouble);
  3600.         }
  3601.         else {
  3602.         if (checksum < 32) {
  3603.             aulong = (1 << checksum) - 1;
  3604.             culong &= aulong;
  3605.         }
  3606.         sv_setuv(sv, (UV)culong);
  3607.         }
  3608.         XPUSHs(sv_2mortal(sv));
  3609.         checksum = 0;
  3610.     }
  3611.     }
  3612.     if (SP == oldsp && gimme == G_SCALAR)
  3613.     PUSHs(&PL_sv_undef);
  3614.     RETURN;
  3615. }
  3616.  
  3617. STATIC void
  3618. doencodes(register SV *sv, register char *s, register I32 len)
  3619. {
  3620.     char hunk[5];
  3621.  
  3622.     *hunk = len + ' ';
  3623.     sv_catpvn(sv, hunk, 1);
  3624.     hunk[4] = '\0';
  3625.     while (len > 0) {
  3626.     hunk[0] = ' ' + (077 & (*s >> 2));
  3627.     hunk[1] = ' ' + (077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)));
  3628.     hunk[2] = ' ' + (077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)));
  3629.     hunk[3] = ' ' + (077 & (s[2] & 077));
  3630.     sv_catpvn(sv, hunk, 4);
  3631.     s += 3;
  3632.     len -= 3;
  3633.     }
  3634.     for (s = SvPVX(sv); *s; s++) {
  3635.     if (*s == ' ')
  3636.         *s = '`';
  3637.     }
  3638.     sv_catpvn(sv, "\n", 1);
  3639. }
  3640.  
  3641. STATIC SV      *
  3642. is_an_int(char *s, STRLEN l)
  3643. {
  3644.   SV             *result = newSVpv("", l);
  3645.   char           *result_c = SvPV(result, PL_na);    /* convenience */
  3646.   char           *out = result_c;
  3647.   bool            skip = 1;
  3648.   bool            ignore = 0;
  3649.  
  3650.   while (*s) {
  3651.     switch (*s) {
  3652.     case ' ':
  3653.       break;
  3654.     case '+':
  3655.       if (!skip) {
  3656.     SvREFCNT_dec(result);
  3657.     return (NULL);
  3658.       }
  3659.       break;
  3660.     case '0':
  3661.     case '1':
  3662.     case '2':
  3663.     case '3':
  3664.     case '4':
  3665.     case '5':
  3666.     case '6':
  3667.     case '7':
  3668.     case '8':
  3669.     case '9':
  3670.       skip = 0;
  3671.       if (!ignore) {
  3672.     *(out++) = *s;
  3673.       }
  3674.       break;
  3675.     case '.':
  3676.       ignore = 1;
  3677.       break;
  3678.     default:
  3679.       SvREFCNT_dec(result);
  3680.       return (NULL);
  3681.     }
  3682.     s++;
  3683.   }
  3684.   *(out++) = '\0';
  3685.   SvCUR_set(result, out - result_c);
  3686.   return (result);
  3687. }
  3688.  
  3689. STATIC int
  3690. div128(SV *pnum, bool *done)
  3691.                                       /* must be '\0' terminated */
  3692.  
  3693. {
  3694.   STRLEN          len;
  3695.   char           *s = SvPV(pnum, len);
  3696.   int             m = 0;
  3697.   int             r = 0;
  3698.   char           *t = s;
  3699.  
  3700.   *done = 1;
  3701.   while (*t) {
  3702.     int             i;
  3703.  
  3704.     i = m * 10 + (*t - '0');
  3705.     m = i & 0x7F;
  3706.     r = (i >> 7);        /* r < 10 */
  3707.     if (r) {
  3708.       *done = 0;
  3709.     }
  3710.     *(t++) = '0' + r;
  3711.   }
  3712.   *(t++) = '\0';
  3713.   SvCUR_set(pnum, (STRLEN) (t - s));
  3714.   return (m);
  3715. }
  3716.  
  3717.  
  3718. PP(pp_pack)
  3719. {
  3720.     djSP; dMARK; dORIGMARK; dTARGET;
  3721.     register SV *cat = TARG;
  3722.     register I32 items;
  3723.     STRLEN fromlen;
  3724.     register char *pat = SvPVx(*++MARK, fromlen);
  3725.     register char *patend = pat + fromlen;
  3726.     register I32 len;
  3727.     I32 datumtype;
  3728.     SV *fromstr;
  3729.     /*SUPPRESS 442*/
  3730.     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
  3731.     static char *space10 = "          ";
  3732.  
  3733.     /* These must not be in registers: */
  3734.     char achar;
  3735.     I16 ashort;
  3736.     int aint;
  3737.     unsigned int auint;
  3738.     I32 along;
  3739.     U32 aulong;
  3740. #ifdef HAS_QUAD
  3741.     Quad_t aquad;
  3742.     unsigned Quad_t auquad;
  3743. #endif
  3744.     char *aptr;
  3745.     float afloat;
  3746.     double adouble;
  3747.     int commas = 0;
  3748.  
  3749.     items = SP - MARK;
  3750.     MARK++;
  3751.     sv_setpvn(cat, "", 0);
  3752.     while (pat < patend) {
  3753. #define NEXTFROM (items-- > 0 ? *MARK++ : &PL_sv_no)
  3754.     datumtype = *pat++ & 0xFF;
  3755.     if (isSPACE(datumtype))
  3756.         continue;
  3757.     if (*pat == '*') {
  3758.         len = strchr("@Xxu", datumtype) ? 0 : items;
  3759.         pat++;
  3760.     }
  3761.     else if (isDIGIT(*pat)) {
  3762.         len = *pat++ - '0';
  3763.         while (isDIGIT(*pat))
  3764.         len = (len * 10) + (*pat++ - '0');
  3765.     }
  3766.     else
  3767.         len = 1;
  3768.     switch(datumtype) {
  3769.     default:
  3770.         croak("Invalid type in pack: '%c'", (int)datumtype);
  3771.     case ',': /* grandfather in commas but with a warning */
  3772.         if (commas++ == 0 && PL_dowarn)
  3773.         warn("Invalid type in pack: '%c'", (int)datumtype);
  3774.         break;
  3775.     case '%':
  3776.         DIE("%% may only be used in unpack");
  3777.     case '@':
  3778.         len -= SvCUR(cat);
  3779.         if (len > 0)
  3780.         goto grow;
  3781.         len = -len;
  3782.         if (len > 0)
  3783.         goto shrink;
  3784.         break;
  3785.     case 'X':
  3786.       shrink:
  3787.         if (SvCUR(cat) < len)
  3788.         DIE("X outside of string");
  3789.         SvCUR(cat) -= len;
  3790.         *SvEND(cat) = '\0';
  3791.         break;
  3792.     case 'x':
  3793.       grow:
  3794.         while (len >= 10) {
  3795.         sv_catpvn(cat, null10, 10);
  3796.         len -= 10;
  3797.         }
  3798.         sv_catpvn(cat, null10, len);
  3799.         break;
  3800.     case 'A':
  3801.     case 'a':
  3802.         fromstr = NEXTFROM;
  3803.         aptr = SvPV(fromstr, fromlen);
  3804.         if (pat[-1] == '*')
  3805.         len = fromlen;
  3806.         if (fromlen > len)
  3807.         sv_catpvn(cat, aptr, len);
  3808.         else {
  3809.         sv_catpvn(cat, aptr, fromlen);
  3810.         len -= fromlen;
  3811.         if (datumtype == 'A') {
  3812.             while (len >= 10) {
  3813.             sv_catpvn(cat, space10, 10);
  3814.             len -= 10;
  3815.             }
  3816.             sv_catpvn(cat, space10, len);
  3817.         }
  3818.         else {
  3819.             while (len >= 10) {
  3820.             sv_catpvn(cat, null10, 10);
  3821.             len -= 10;
  3822.             }
  3823.             sv_catpvn(cat, null10, len);
  3824.         }
  3825.         }
  3826.         break;
  3827.     case 'B':
  3828.     case 'b':
  3829.         {
  3830.         char *savepat = pat;
  3831.         I32 saveitems;
  3832.  
  3833.         fromstr = NEXTFROM;
  3834.         saveitems = items;
  3835.         aptr = SvPV(fromstr, fromlen);
  3836.         if (pat[-1] == '*')
  3837.             len = fromlen;
  3838.         pat = aptr;
  3839.         aint = SvCUR(cat);
  3840.         SvCUR(cat) += (len+7)/8;
  3841.         SvGROW(cat, SvCUR(cat) + 1);
  3842.         aptr = SvPVX(cat) + aint;
  3843.         if (len > fromlen)
  3844.             len = fromlen;
  3845.         aint = len;
  3846.         items = 0;
  3847.         if (datumtype == 'B') {
  3848.             for (len = 0; len++ < aint;) {
  3849.             items |= *pat++ & 1;
  3850.             if (len & 7)
  3851.                 items <<= 1;
  3852.             else {
  3853.                 *aptr++ = items & 0xff;
  3854.                 items = 0;
  3855.             }
  3856.             }
  3857.         }
  3858.         else {
  3859.             for (len = 0; len++ < aint;) {
  3860.             if (*pat++ & 1)
  3861.                 items |= 128;
  3862.             if (len & 7)
  3863.                 items >>= 1;
  3864.             else {
  3865.                 *aptr++ = items & 0xff;
  3866.                 items = 0;
  3867.             }
  3868.             }
  3869.         }
  3870.         if (aint & 7) {
  3871.             if (datumtype == 'B')
  3872.             items <<= 7 - (aint & 7);
  3873.             else
  3874.             items >>= 7 - (aint & 7);
  3875.             *aptr++ = items & 0xff;
  3876.         }
  3877.         pat = SvPVX(cat) + SvCUR(cat);
  3878.         while (aptr <= pat)
  3879.             *aptr++ = '\0';
  3880.  
  3881.         pat = savepat;
  3882.         items = saveitems;
  3883.         }
  3884.         break;
  3885.     case 'H':
  3886.     case 'h':
  3887.         {
  3888.         char *savepat = pat;
  3889.         I32 saveitems;
  3890.  
  3891.         fromstr = NEXTFROM;
  3892.         saveitems = items;
  3893.         aptr = SvPV(fromstr, fromlen);
  3894.         if (pat[-1] == '*')
  3895.             len = fromlen;
  3896.         pat = aptr;
  3897.         aint = SvCUR(cat);
  3898.         SvCUR(cat) += (len+1)/2;
  3899.         SvGROW(cat, SvCUR(cat) + 1);
  3900.         aptr = SvPVX(cat) + aint;
  3901.         if (len > fromlen)
  3902.             len = fromlen;
  3903.         aint = len;
  3904.         items = 0;
  3905.         if (datumtype == 'H') {
  3906.             for (len = 0; len++ < aint;) {
  3907.             if (isALPHA(*pat))
  3908.                 items |= ((*pat++ & 15) + 9) & 15;
  3909.             else
  3910.                 items |= *pat++ & 15;
  3911.             if (len & 1)
  3912.                 items <<= 4;
  3913.             else {
  3914.                 *aptr++ = items & 0xff;
  3915.                 items = 0;
  3916.             }
  3917.             }
  3918.         }
  3919.         else {
  3920.             for (len = 0; len++ < aint;) {
  3921.             if (isALPHA(*pat))
  3922.                 items |= (((*pat++ & 15) + 9) & 15) << 4;
  3923.             else
  3924.                 items |= (*pat++ & 15) << 4;
  3925.             if (len & 1)
  3926.                 items >>= 4;
  3927.             else {
  3928.                 *aptr++ = items & 0xff;
  3929.                 items = 0;
  3930.             }
  3931.             }
  3932.         }
  3933.         if (aint & 1)
  3934.             *aptr++ = items & 0xff;
  3935.         pat = SvPVX(cat) + SvCUR(cat);
  3936.         while (aptr <= pat)
  3937.             *aptr++ = '\0';
  3938.  
  3939.         pat = savepat;
  3940.         items = saveitems;
  3941.         }
  3942.         break;
  3943.     case 'C':
  3944.     case 'c':
  3945.         while (len-- > 0) {
  3946.         fromstr = NEXTFROM;
  3947.         aint = SvIV(fromstr);
  3948.         achar = aint;
  3949.         sv_catpvn(cat, &achar, sizeof(char));
  3950.         }
  3951.         break;
  3952.     /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
  3953.     case 'f':
  3954.     case 'F':
  3955.         while (len-- > 0) {
  3956.         fromstr = NEXTFROM;
  3957.         afloat = (float)SvNV(fromstr);
  3958.         sv_catpvn(cat, (char *)&afloat, sizeof (float));
  3959.         }
  3960.         break;
  3961.     case 'd':
  3962.     case 'D':
  3963.         while (len-- > 0) {
  3964.         fromstr = NEXTFROM;
  3965.         adouble = (double)SvNV(fromstr);
  3966.         sv_catpvn(cat, (char *)&adouble, sizeof (double));
  3967.         }
  3968.         break;
  3969.     case 'n':
  3970.         while (len-- > 0) {
  3971.         fromstr = NEXTFROM;
  3972.         ashort = (I16)SvIV(fromstr);
  3973. #ifdef HAS_HTONS
  3974.         ashort = PerlSock_htons(ashort);
  3975. #endif
  3976.         CAT16(cat, &ashort);
  3977.         }
  3978.         break;
  3979.     case 'v':
  3980.         while (len-- > 0) {
  3981.         fromstr = NEXTFROM;
  3982.         ashort = (I16)SvIV(fromstr);
  3983. #ifdef HAS_HTOVS
  3984.         ashort = htovs(ashort);
  3985. #endif
  3986.         CAT16(cat, &ashort);
  3987.         }
  3988.         break;
  3989.     case 'S':
  3990.     case 's':
  3991.         while (len-- > 0) {
  3992.         fromstr = NEXTFROM;
  3993.         ashort = (I16)SvIV(fromstr);
  3994.         CAT16(cat, &ashort);
  3995.         }
  3996.         break;
  3997.     case 'I':
  3998.         while (len-- > 0) {
  3999.         fromstr = NEXTFROM;
  4000.         auint = SvUV(fromstr);
  4001.         sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
  4002.         }
  4003.         break;
  4004.     case 'w':
  4005.             while (len-- > 0) {
  4006.         fromstr = NEXTFROM;
  4007.         adouble = floor(SvNV(fromstr));
  4008.  
  4009.         if (adouble < 0)
  4010.             croak("Cannot compress negative numbers");
  4011.  
  4012.         if (
  4013. #ifdef BW_BITS
  4014.             adouble <= BW_MASK
  4015. #else
  4016. #ifdef CXUX_BROKEN_CONSTANT_CONVERT
  4017.             adouble <= UV_MAX_cxux
  4018. #else
  4019.             adouble <= UV_MAX
  4020. #endif
  4021. #endif
  4022.             )
  4023.         {
  4024.             char   buf[1 + sizeof(UV)];
  4025.             char  *in = buf + sizeof(buf);
  4026.             UV     auv = U_V(adouble);;
  4027.  
  4028.             do {
  4029.             *--in = (auv & 0x7f) | 0x80;
  4030.             auv >>= 7;
  4031.             } while (auv);
  4032.             buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
  4033.             sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
  4034.         }
  4035.         else if (SvPOKp(fromstr)) {  /* decimal string arithmetics */
  4036.             char           *from, *result, *in;
  4037.             SV             *norm;
  4038.             STRLEN          len;
  4039.             bool            done;
  4040.  
  4041.             /* Copy string and check for compliance */
  4042.             from = SvPV(fromstr, len);
  4043.             if ((norm = is_an_int(from, len)) == NULL)
  4044.             croak("can compress only unsigned integer");
  4045.  
  4046.             New('w', result, len, char);
  4047.             in = result + len;
  4048.             done = FALSE;
  4049.             while (!done)
  4050.             *--in = div128(norm, &done) | 0x80;
  4051.             result[len - 1] &= 0x7F; /* clear continue bit */
  4052.             sv_catpvn(cat, in, (result + len) - in);
  4053.             Safefree(result);
  4054.             SvREFCNT_dec(norm);    /* free norm */
  4055.                 }
  4056.         else if (SvNOKp(fromstr)) {
  4057.             char   buf[sizeof(double) * 2];    /* 8/7 <= 2 */
  4058.             char  *in = buf + sizeof(buf);
  4059.  
  4060.             do {
  4061.             double next = floor(adouble / 128);
  4062.             *--in = (unsigned char)(adouble - (next * 128)) | 0x80;
  4063.             if (--in < buf)  /* this cannot happen ;-) */
  4064.                 croak ("Cannot compress integer");
  4065.             adouble = next;
  4066.             } while (adouble > 0);
  4067.             buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
  4068.             sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
  4069.         }
  4070.         else
  4071.             croak("Cannot compress non integer");
  4072.         }
  4073.             break;
  4074.     case 'i':
  4075.         while (len-- > 0) {
  4076.         fromstr = NEXTFROM;
  4077.         aint = SvIV(fromstr);
  4078.         sv_catpvn(cat, (char*)&aint, sizeof(int));
  4079.         }
  4080.         break;
  4081.     case 'N':
  4082.         while (len-- > 0) {
  4083.         fromstr = NEXTFROM;
  4084.         aulong = SvUV(fromstr);
  4085. #ifdef HAS_HTONL
  4086.         aulong = PerlSock_htonl(aulong);
  4087. #endif
  4088.         CAT32(cat, &aulong);
  4089.         }
  4090.         break;
  4091.     case 'V':
  4092.         while (len-- > 0) {
  4093.         fromstr = NEXTFROM;
  4094.         aulong = SvUV(fromstr);
  4095. #ifdef HAS_HTOVL
  4096.         aulong = htovl(aulong);
  4097. #endif
  4098.         CAT32(cat, &aulong);
  4099.         }
  4100.         break;
  4101.     case 'L':
  4102.         while (len-- > 0) {
  4103.         fromstr = NEXTFROM;
  4104.         aulong = SvUV(fromstr);
  4105.         CAT32(cat, &aulong);
  4106.         }
  4107.         break;
  4108.     case 'l':
  4109.         while (len-- > 0) {
  4110.         fromstr = NEXTFROM;
  4111.         along = SvIV(fromstr);
  4112.         CAT32(cat, &along);
  4113.         }
  4114.         break;
  4115. #ifdef HAS_QUAD
  4116.     case 'Q':
  4117.         while (len-- > 0) {
  4118.         fromstr = NEXTFROM;
  4119.         auquad = (unsigned Quad_t)SvIV(fromstr);
  4120.         sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
  4121.         }
  4122.         break;
  4123.     case 'q':
  4124.         while (len-- > 0) {
  4125.         fromstr = NEXTFROM;
  4126.         aquad = (Quad_t)SvIV(fromstr);
  4127.         sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
  4128.         }
  4129.         break;
  4130. #endif /* HAS_QUAD */
  4131.     case 'P':
  4132.         len = 1;        /* assume SV is correct length */
  4133.         /* FALL THROUGH */
  4134.     case 'p':
  4135.         while (len-- > 0) {
  4136.         fromstr = NEXTFROM;
  4137.         if (fromstr == &PL_sv_undef)
  4138.             aptr = NULL;
  4139.         else {
  4140.             /* XXX better yet, could spirit away the string to
  4141.              * a safe spot and hang on to it until the result
  4142.              * of pack() (and all copies of the result) are
  4143.              * gone.
  4144.              */
  4145.             if (PL_dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
  4146.             warn("Attempt to pack pointer to temporary value");
  4147.             if (SvPOK(fromstr) || SvNIOK(fromstr))
  4148.             aptr = SvPV(fromstr,PL_na);
  4149.             else
  4150.             aptr = SvPV_force(fromstr,PL_na);
  4151.         }
  4152.         sv_catpvn(cat, (char*)&aptr, sizeof(char*));
  4153.         }
  4154.         break;
  4155.     case 'u':
  4156.         fromstr = NEXTFROM;
  4157.         aptr = SvPV(fromstr, fromlen);
  4158.         SvGROW(cat, fromlen * 4 / 3);
  4159.         if (len <= 1)
  4160.         len = 45;
  4161.         else
  4162.         len = len / 3 * 3;
  4163.         while (fromlen > 0) {
  4164.         I32 todo;
  4165.  
  4166.         if (fromlen > len)
  4167.             todo = len;
  4168.         else
  4169.             todo = fromlen;
  4170.         doencodes(cat, aptr, todo);
  4171.         fromlen -= todo;
  4172.         aptr += todo;
  4173.         }
  4174.         break;
  4175.     }
  4176.     }
  4177.     SvSETMAGIC(cat);
  4178.     SP = ORIGMARK;
  4179.     PUSHs(cat);
  4180.     RETURN;
  4181. }
  4182. #undef NEXTFROM
  4183.  
  4184.  
  4185. PP(pp_split)
  4186. {
  4187.     djSP; dTARG;
  4188.     AV *ary;
  4189.     register I32 limit = POPi;            /* note, negative is forever */
  4190.     SV *sv = POPs;
  4191.     STRLEN len;
  4192.     register char *s = SvPV(sv, len);
  4193.     char *strend = s + len;
  4194.     register PMOP *pm;
  4195.     register REGEXP *rx;
  4196.     register SV *dstr;
  4197.     register char *m;
  4198.     I32 iters = 0;
  4199.     I32 maxiters = (strend - s) + 10;
  4200.     I32 i;
  4201.     char *orig;
  4202.     I32 origlimit = limit;
  4203.     I32 realarray = 0;
  4204.     I32 base;
  4205.     AV *oldstack = PL_curstack;
  4206.     I32 gimme = GIMME_V;
  4207.     I32 oldsave = PL_savestack_ix;
  4208.     I32 make_mortal = 1;
  4209.     MAGIC *mg = (MAGIC *) NULL;
  4210.  
  4211. #ifdef DEBUGGING
  4212.     Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
  4213. #else
  4214.     pm = (PMOP*)POPs;
  4215. #endif
  4216.     if (!pm || !s)
  4217.     DIE("panic: do_split");
  4218.     rx = pm->op_pmregexp;
  4219.  
  4220.     TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
  4221.          (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
  4222.  
  4223.     if (pm->op_pmreplroot)
  4224.     ary = GvAVn((GV*)pm->op_pmreplroot);
  4225.     else if (gimme != G_ARRAY)
  4226. #ifdef USE_THREADS
  4227.     ary = (AV*)PL_curpad[0];
  4228. #else
  4229.     ary = GvAVn(PL_defgv);
  4230. #endif /* USE_THREADS */
  4231.     else
  4232.     ary = Nullav;
  4233.     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
  4234.     realarray = 1;
  4235.     PUTBACK;
  4236.     av_extend(ary,0);
  4237.     av_clear(ary);
  4238.     SPAGAIN;
  4239.     if (SvRMAGICAL(ary) && (mg = mg_find((SV *) ary, 'P'))) {
  4240.         PUSHMARK(SP);
  4241.         XPUSHs(mg->mg_obj);
  4242.     }
  4243.     else {
  4244.         if (!AvREAL(ary)) {
  4245.         AvREAL_on(ary);
  4246.         for (i = AvFILLp(ary); i >= 0; i--)
  4247.             AvARRAY(ary)[i] = &PL_sv_undef;    /* don't free mere refs */
  4248.         }
  4249.         /* temporarily switch stacks */
  4250.         SWITCHSTACK(PL_curstack, ary);
  4251.         make_mortal = 0;
  4252.     }
  4253.     }
  4254.     base = SP - PL_stack_base;
  4255.     orig = s;
  4256.     if (pm->op_pmflags & PMf_SKIPWHITE) {
  4257.     if (pm->op_pmflags & PMf_LOCALE) {
  4258.         while (isSPACE_LC(*s))
  4259.         s++;
  4260.     }
  4261.     else {
  4262.         while (isSPACE(*s))
  4263.         s++;
  4264.     }
  4265.     }
  4266.     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  4267.     SAVEINT(PL_multiline);
  4268.     PL_multiline = pm->op_pmflags & PMf_MULTILINE;
  4269.     }
  4270.  
  4271.     if (!limit)
  4272.     limit = maxiters + 2;
  4273.     if (pm->op_pmflags & PMf_WHITE) {
  4274.     while (--limit) {
  4275.         m = s;
  4276.         while (m < strend &&
  4277.            !((pm->op_pmflags & PMf_LOCALE)
  4278.              ? isSPACE_LC(*m) : isSPACE(*m)))
  4279.         ++m;
  4280.         if (m >= strend)
  4281.         break;
  4282.  
  4283.         dstr = NEWSV(30, m-s);
  4284.         sv_setpvn(dstr, s, m-s);
  4285.         if (make_mortal)
  4286.         sv_2mortal(dstr);
  4287.         XPUSHs(dstr);
  4288.  
  4289.         s = m + 1;
  4290.         while (s < strend &&
  4291.            ((pm->op_pmflags & PMf_LOCALE)
  4292.             ? isSPACE_LC(*s) : isSPACE(*s)))
  4293.         ++s;
  4294.     }
  4295.     }
  4296.     else if (strEQ("^", rx->precomp)) {
  4297.     while (--limit) {
  4298.         /*SUPPRESS 530*/
  4299.         for (m = s; m < strend && *m != '\n'; m++) ;
  4300.         m++;
  4301.         if (m >= strend)
  4302.         break;
  4303.         dstr = NEWSV(30, m-s);
  4304.         sv_setpvn(dstr, s, m-s);
  4305.         if (make_mortal)
  4306.         sv_2mortal(dstr);
  4307.         XPUSHs(dstr);
  4308.         s = m;
  4309.     }
  4310.     }
  4311.     else if (rx->check_substr && !rx->nparens
  4312.          && (rx->reganch & ROPT_CHECK_ALL)
  4313.          && !(rx->reganch & ROPT_ANCH)) {
  4314.     i = SvCUR(rx->check_substr);
  4315.     if (i == 1 && !SvTAIL(rx->check_substr)) {
  4316.         i = *SvPVX(rx->check_substr);
  4317.         while (--limit) {
  4318.         /*SUPPRESS 530*/
  4319.         for (m = s; m < strend && *m != i; m++) ;
  4320.         if (m >= strend)
  4321.             break;
  4322.         dstr = NEWSV(30, m-s);
  4323.         sv_setpvn(dstr, s, m-s);
  4324.         if (make_mortal)
  4325.             sv_2mortal(dstr);
  4326.         XPUSHs(dstr);
  4327.         s = m + 1;
  4328.         }
  4329.     }
  4330.     else {
  4331. #ifndef lint
  4332.         while (s < strend && --limit &&
  4333.           (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
  4334.             rx->check_substr, 0)) )
  4335. #endif
  4336.         {
  4337.         dstr = NEWSV(31, m-s);
  4338.         sv_setpvn(dstr, s, m-s);
  4339.         if (make_mortal)
  4340.             sv_2mortal(dstr);
  4341.         XPUSHs(dstr);
  4342.         s = m + i;
  4343.         }
  4344.     }
  4345.     }
  4346.     else {
  4347.     maxiters += (strend - s) * rx->nparens;
  4348.     while (s < strend && --limit &&
  4349.            CALLREGEXEC(rx, s, strend, orig, 1, Nullsv, NULL, 0))
  4350.     {
  4351.         TAINT_IF(RX_MATCH_TAINTED(rx));
  4352.         if (rx->subbase
  4353.           && rx->subbase != orig) {
  4354.         m = s;
  4355.         s = orig;
  4356.         orig = rx->subbase;
  4357.         s = orig + (m - s);
  4358.         strend = s + (strend - m);
  4359.         }
  4360.         m = rx->startp[0];
  4361.         dstr = NEWSV(32, m-s);
  4362.         sv_setpvn(dstr, s, m-s);
  4363.         if (make_mortal)
  4364.         sv_2mortal(dstr);
  4365.         XPUSHs(dstr);
  4366.         if (rx->nparens) {
  4367.         for (i = 1; i <= rx->nparens; i++) {
  4368.             s = rx->startp[i];
  4369.             m = rx->endp[i];
  4370.             if (m && s) {
  4371.             dstr = NEWSV(33, m-s);
  4372.             sv_setpvn(dstr, s, m-s);
  4373.             }
  4374.             else
  4375.             dstr = NEWSV(33, 0);
  4376.             if (make_mortal)
  4377.             sv_2mortal(dstr);
  4378.             XPUSHs(dstr);
  4379.         }
  4380.         }
  4381.         s = rx->endp[0];
  4382.     }
  4383.     }
  4384.  
  4385.     LEAVE_SCOPE(oldsave);
  4386.     iters = (SP - PL_stack_base) - base;
  4387.     if (iters > maxiters)
  4388.     DIE("Split loop");
  4389.  
  4390.     /* keep field after final delim? */
  4391.     if (s < strend || (iters && origlimit)) {
  4392.     dstr = NEWSV(34, strend-s);
  4393.     sv_setpvn(dstr, s, strend-s);
  4394.     if (make_mortal)
  4395.         sv_2mortal(dstr);
  4396.     XPUSHs(dstr);
  4397.     iters++;
  4398.     }
  4399.     else if (!origlimit) {
  4400.     while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
  4401.         iters--, SP--;
  4402.     }
  4403.  
  4404.     if (realarray) {
  4405.     if (!mg) {
  4406.         SWITCHSTACK(ary, oldstack);
  4407.         if (SvSMAGICAL(ary)) {
  4408.         PUTBACK;
  4409.         mg_set((SV*)ary);
  4410.         SPAGAIN;
  4411.         }
  4412.         if (gimme == G_ARRAY) {
  4413.         EXTEND(SP, iters);
  4414.         Copy(AvARRAY(ary), SP + 1, iters, SV*);
  4415.         SP += iters;
  4416.         RETURN;
  4417.         }
  4418.     }
  4419.     else {
  4420.         PUTBACK;
  4421.         ENTER;
  4422.         perl_call_method("PUSH",G_SCALAR|G_DISCARD);
  4423.         LEAVE;
  4424.         SPAGAIN;
  4425.         if (gimme == G_ARRAY) {
  4426.         /* EXTEND should not be needed - we just popped them */
  4427.         EXTEND(SP, iters);
  4428.         for (i=0; i < iters; i++) {
  4429.             SV **svp = av_fetch(ary, i, FALSE);
  4430.             PUSHs((svp) ? *svp : &PL_sv_undef);
  4431.         }
  4432.         RETURN;
  4433.         }
  4434.     }
  4435.     }
  4436.     else {
  4437.     if (gimme == G_ARRAY)
  4438.         RETURN;
  4439.     }
  4440.     if (iters || !pm->op_pmreplroot) {
  4441.     GETTARGET;
  4442.     PUSHi(iters);
  4443.     RETURN;
  4444.     }
  4445.     RETPUSHUNDEF;
  4446. }
  4447.  
  4448. #ifdef USE_THREADS
  4449. void
  4450. unlock_condpair(void *svv)
  4451. {
  4452.     dTHR;
  4453.     MAGIC *mg = mg_find((SV*)svv, 'm');
  4454.  
  4455.     if (!mg)
  4456.     croak("panic: unlock_condpair unlocking non-mutex");
  4457.     MUTEX_LOCK(MgMUTEXP(mg));
  4458.     if (MgOWNER(mg) != thr)
  4459.     croak("panic: unlock_condpair unlocking mutex that we don't own");
  4460.     MgOWNER(mg) = 0;
  4461.     COND_SIGNAL(MgOWNERCONDP(mg));
  4462.     DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
  4463.               (unsigned long)thr, (unsigned long)svv);)
  4464.     MUTEX_UNLOCK(MgMUTEXP(mg));
  4465. }
  4466. #endif /* USE_THREADS */
  4467.  
  4468. PP(pp_lock)
  4469. {
  4470.     djSP;
  4471.     dTOPss;
  4472.     SV *retsv = sv;
  4473. #ifdef USE_THREADS
  4474.     MAGIC *mg;
  4475.  
  4476.     if (SvROK(sv))
  4477.     sv = SvRV(sv);
  4478.  
  4479.     mg = condpair_magic(sv);
  4480.     MUTEX_LOCK(MgMUTEXP(mg));
  4481.     if (MgOWNER(mg) == thr)
  4482.     MUTEX_UNLOCK(MgMUTEXP(mg));
  4483.     else {
  4484.     while (MgOWNER(mg))
  4485.         COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
  4486.     MgOWNER(mg) = thr;
  4487.     DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
  4488.                   (unsigned long)thr, (unsigned long)sv);)
  4489.     MUTEX_UNLOCK(MgMUTEXP(mg));
  4490.     SvREFCNT_inc(sv);    /* keep alive until magic_mutexfree */
  4491.     save_destructor(unlock_condpair, sv);
  4492.     }
  4493. #endif /* USE_THREADS */
  4494.     if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
  4495.     || SvTYPE(retsv) == SVt_PVCV) {
  4496.     retsv = refto(retsv);
  4497.     }
  4498.     SETs(retsv);
  4499.     RETURN;
  4500. }
  4501.  
  4502. PP(pp_threadsv)
  4503. {
  4504.     djSP;
  4505. #ifdef USE_THREADS
  4506.     EXTEND(SP, 1);
  4507.     if (PL_op->op_private & OPpLVAL_INTRO)
  4508.     PUSHs(*save_threadsv(PL_op->op_targ));
  4509.     else
  4510.     PUSHs(THREADSV(PL_op->op_targ));
  4511.     RETURN;
  4512. #else
  4513.     DIE("tried to access per-thread data in non-threaded perl");
  4514. #endif /* USE_THREADS */
  4515. }
  4516.